    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE MultiParamTypeClasses #-}

    --------------------------------------------------------------------------------
    --  See end of this file for licence information.
    --------------------------------------------------------------------------------
    -- |
    --  Module      :  GraphMatch
    --  Copyright   :  (c) 2003, Graham Klyne, 2009 Vasili I Galchin,
    --                 2011, 2012, 2016, 2018, 2020, 2022, 2024 Douglas Burke
    --  License     :  GPL V2
    --
    --  Maintainer  :  Douglas Burke
    --  Stability   :  experimental
    --  Portability :  FlexibleInstances, MultiParamTypeClasses
    --
    --  This module contains graph-matching logic.
    --
    --  The algorithm used is derived from a paper on RDF graph matching
    --  by Jeremy Carroll <http://www.hpl.hp.com/techreports/2001/HPL-2001-293.html>.
    --
    --------------------------------------------------------------------------------

    module Swish.GraphMatch
          ( graphMatch,
            -- * Exported for testing
            LabelMap, GenLabelMap(..), LabelEntry, GenLabelEntry(..),
            ScopedLabel(..), makeScopedLabel, makeScopedArc,
            LabelIndex, EquivalenceClass, nullLabelVal, emptyMap,
            labelIsVar, labelHash,
            mapLabelIndex, setLabelHash, newLabelMap,
            graphLabels, assignLabelMap, newGenerationMap,
            graphMatch1, graphMatch2, equivalenceClasses, reclassify
          ) where

    import qualified Data.List as L
    import qualified Data.Map as M
    import qualified Data.Set as S

    import Control.Exception.Base (assert)
    import Control.Arrow (second)

    import Data.Foldable (Foldable(..))
    import Data.Function (on)
    import Data.Hashable (hashWithSalt)
    import Data.List (sortBy, groupBy, partition)
    import Data.Ord (comparing)
    import Data.Word

    -- Avoid messages added in GHC 9.10 about foldl' import from Data.List
    -- being redundant.
    import Prelude hiding (Foldable(..))

    import Swish.GraphClass (Arc(..), ArcSet, Label(..))
    import Swish.GraphClass (getComponents, arcLabels, hasLabel, arcToTriple)

    --------------------------
    --  Label index value type
    --------------------------
    --

    -- | LabelIndex is a unique value assigned to each label, such that
    --  labels with different values are definitely different values
    --  in the graph;  e.g. do not map to each other in the graph
    --  bijection.  The first member is a generation counter that
    --  ensures new values are distinct from earlier passes.

    type LabelIndex = (Word32, Word32)

    -- | The null, or empty, index value.
    nullLabelVal :: LabelIndex
    nullLabelVal :: LabelIndex
    nullLabelVal = (Word32
    0, Word32
    0)

    -----------------------
    --  Label mapping types
    -----------------------

    -- | A Mapping between a label and a value (e.g. an index
    -- value).
    data (Label lb) => GenLabelEntry lb lv = LabelEntry lb lv

    -- | A label associated with a 'LabelIndex'
    type LabelEntry lb = GenLabelEntry lb LabelIndex

    instance (Label lb, Show lv) => Show (GenLabelEntry lb lv) where
        show :: GenLabelEntry lb lv -> String
    show (LabelEntry lb
    k lv
    v) = lb -> String
    forall a. Show a => a -> String
    show lb
    k String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ":" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ lv -> String
    forall a. Show a => a -> String
    show lv
    v

    instance (Label lb, Eq lv) => Eq (GenLabelEntry lb lv) where
        (LabelEntry lb
    k1 lv
    v1) == :: GenLabelEntry lb lv -> GenLabelEntry lb lv -> Bool
    == (LabelEntry lb
    k2 lv
    v2) = (lb
    k1,lv
    v1) (lb, lv) -> (lb, lv) -> Bool
    forall a. Eq a => a -> a -> Bool
    == (lb
    k2,lv
    v2)

    instance (Label lb, Ord lv) => Ord (GenLabelEntry lb lv) where
        (LabelEntry lb
    lb1 lv
    lv1) compare :: GenLabelEntry lb lv -> GenLabelEntry lb lv -> Ordering
    `compare` (LabelEntry lb
    lb2 lv
    lv2) =
            (lb
    lb1, lv
    lv1) (lb, lv) -> (lb, lv) -> Ordering
    forall a. Ord a => a -> a -> Ordering
    `compare` (lb
    lb2, lv
    lv2)

    -- | Type for label->index lookup table
    data (Label lb, Eq lv, Show lv) => GenLabelMap lb lv =
        LabelMap Word32 (M.Map lb lv)

    -- | A label lookup table specialized to 'LabelIndex' indices.
    type LabelMap lb = GenLabelMap lb LabelIndex

    instance (Label lb) => Show (LabelMap lb) where
        show :: LabelMap lb -> String
    show = LabelMap lb -> String
    forall lb. Label lb => LabelMap lb -> String
    showLabelMap

    instance (Label lb) => Eq (LabelMap lb) where
        LabelMap Word32
    gen1 Map lb LabelIndex
    lmap1 == :: LabelMap lb -> LabelMap lb -> Bool
    == LabelMap Word32
    gen2 Map lb LabelIndex
    lmap2 =
          (Word32
    gen1, Map lb LabelIndex
    lmap1) (Word32, Map lb LabelIndex) -> (Word32, Map lb LabelIndex) -> Bool
    forall a. Eq a => a -> a -> Bool
    == (Word32
    gen2, Map lb LabelIndex
    lmap2)

    -- | The empty label map table.
    emptyMap :: (Label lb) => LabelMap lb
    emptyMap :: forall lb. Label lb => LabelMap lb
    emptyMap = Word32 -> Map lb LabelIndex -> GenLabelMap lb LabelIndex
    forall lb lv.
    (Label lb, Eq lv, Show lv) =>
    Word32 -> Map lb lv -> GenLabelMap lb lv
    LabelMap Word32
    1 Map lb LabelIndex
    forall k a. Map k a
    M.empty

    --------------------------
    --  Equivalence class type
    --------------------------
    --

    -- | Type for equivalence class description
    --  (An equivalence class is a collection of labels with
    --  the same 'LabelIndex' value.)

    type EquivalenceClass lb = (LabelIndex, [lb])

    {-
    ecIndex :: EquivalenceClass lb -> LabelIndex
    ecIndex = fst
    -}

    ecLabels :: EquivalenceClass lb -> [lb]
    ecLabels :: forall lb. EquivalenceClass lb -> [lb]
    ecLabels = (LabelIndex, [lb]) -> [lb]
    forall a b. (a, b) -> b
    snd

    {-
    ecSize :: EquivalenceClass lb -> Int
    ecSize = length . ecLabels
    -}

    ecRemoveLabel :: (Label lb) => EquivalenceClass lb -> lb -> EquivalenceClass lb
    ecRemoveLabel :: forall lb.
    Label lb =>
    EquivalenceClass lb -> lb -> EquivalenceClass lb
    ecRemoveLabel EquivalenceClass lb
    xs lb
    l = ([lb] -> [lb]) -> EquivalenceClass lb -> EquivalenceClass lb
    forall b c d. (b -> c) -> (d, b) -> (d, c)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second (lb -> [lb] -> [lb]
    forall a. Eq a => a -> [a] -> [a]
    L.delete lb
    l) EquivalenceClass lb
    xs

    ------------------------------------------------------------
    --  Filter, ungroup, sort and group pairs by first member
    ------------------------------------------------------------

    {-
    pairSelect :: ((a,b) -> Bool) -> ((a,b) -> c) -> [(a,b)] -> [c]
    pairSelect p f as = map f (filter p as)
    -}

    -- | Ungroup the pairs.
    pairUngroup ::
        (a,[b])    -- ^ Given (a,bs)
        -> [(a,b)] -- ^ Returns (a,b) for all b in bs
    pairUngroup :: forall a b. (a, [b]) -> [(a, b)]
    pairUngroup (a
    a,[b]
    bs) = [ (a
    a,b
    b) | b
    b <- [b]
    bs ]

    -- | Order the pairs based on the first argument.
    pairSort :: (Ord a) => [(a,b)] -> [(a,b)]
    pairSort :: forall a b. Ord a => [(a, b)] -> [(a, b)]
    pairSort = ((a, b) -> (a, b) -> Ordering) -> [(a, b)] -> [(a, b)]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy (((a, b) -> a) -> (a, b) -> (a, b) -> Ordering
    forall a b. Ord a => (b -> a) -> b -> b -> Ordering
    comparing (a, b) -> a
    forall a b. (a, b) -> a
    fst)

    -- TODO: use set on input

    -- | Group the pairs based on the first argument.
    pairGroup :: (Ord a) => [(a,b)] -> [(a,[b])]
    pairGroup :: forall a b. Ord a => [(a, b)] -> [(a, [b])]
    pairGroup = ([(a, b)] -> (a, [b])) -> [[(a, b)]] -> [(a, [b])]
    forall a b. (a -> b) -> [a] -> [b]
    map (([a], [b]) -> (a, [b])
    forall {a} {b}. ([a], b) -> (a, b)
    factor (([a], [b]) -> (a, [b]))
    -> ([(a, b)] -> ([a], [b])) -> [(a, b)] -> (a, [b])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(a, b)] -> ([a], [b])
    forall a b. [(a, b)] -> ([a], [b])
    unzip) ([[(a, b)]] -> [(a, [b])])
    -> ([(a, b)] -> [[(a, b)]]) -> [(a, b)] -> [(a, [b])]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((a, b) -> (a, b) -> Bool) -> [(a, b)] -> [[(a, b)]]
    forall a. (a -> a -> Bool) -> [a] -> [[a]]
    groupBy (a, b) -> (a, b) -> Bool
    forall {b}. (a, b) -> (a, b) -> Bool
    eqFirst ([(a, b)] -> [[(a, b)]])
    -> ([(a, b)] -> [(a, b)]) -> [(a, b)] -> [[(a, b)]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(a, b)] -> [(a, b)]
    forall a b. Ord a => [(a, b)] -> [(a, b)]
    pairSort
        where
          -- as is not [] by construction, but would be nice to have
          -- this enforced by the types
          factor :: ([a], b) -> (a, b)
    factor ([], b
    _) = String -> (a, b)
    forall a. HasCallStack => String -> a
    error String
    "internal error"
          factor (a
    a:[a]
    _, b
    bs) = (a
    a, b
    bs)
          eqFirst :: (a, b) -> (a, b) -> Bool
    eqFirst = a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) (a -> a -> Bool) -> ((a, b) -> a) -> (a, b) -> (a, b) -> Bool
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` (a, b) -> a
    forall a b. (a, b) -> a
    fst

    ------------------------------------------------------------
    --  Augmented graph label value - for graph matching
    ------------------------------------------------------------
    --
    -- | This instance of class label adds a graph identifier to
    --  each variable label, so that variable labels from
    --  different graphs are always seen as distinct values.
    --
    --  The essential logic added by this class instance is embodied
    --  in the eq and hash functions.  Note that variable label hashes
    --  depend only on the graph in which they appear, and non-variable
    --  label hashes depend only on the variable.  Label hash values are
    --  used when initializing a label equivalence-class map (and, for
    --  non-variable labels, also for resolving hash collisions).

    data (Label lb) => ScopedLabel lb = ScopedLabel Int lb

    -- | Create a scoped label given an identifier and label.
    makeScopedLabel :: (Label lb) => Int -> lb -> ScopedLabel lb
    makeScopedLabel :: forall lb. Label lb => Int -> lb -> ScopedLabel lb
    makeScopedLabel = Int -> lb -> ScopedLabel lb
    forall lb. Label lb => Int -> lb -> ScopedLabel lb
    ScopedLabel

    -- | Create an arc containining a scoped label with the given identifier.
    makeScopedArc :: (Label lb) => Int -> Arc lb -> Arc (ScopedLabel lb)
    makeScopedArc :: forall lb. Label lb => Int -> Arc lb -> Arc (ScopedLabel lb)
    makeScopedArc Int
    scope = (lb -> ScopedLabel lb) -> Arc lb -> Arc (ScopedLabel lb)
    forall a b. (a -> b) -> Arc a -> Arc b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Int -> lb -> ScopedLabel lb
    forall lb. Label lb => Int -> lb -> ScopedLabel lb
    ScopedLabel Int
    scope)

    instance (Label lb) => Label (ScopedLabel lb) where
        getLocal :: ScopedLabel lb -> String
    getLocal  ScopedLabel lb
    lab    = ShowS
    forall a. HasCallStack => String -> a
    error ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ String
    "getLocal for ScopedLabel: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ScopedLabel lb -> String
    forall a. Show a => a -> String
    show ScopedLabel lb
    lab
        makeLabel :: String -> ScopedLabel lb
    makeLabel String
    locnam = String -> ScopedLabel lb
    forall a. HasCallStack => String -> a
    error (String -> ScopedLabel lb) -> String -> ScopedLabel lb
    forall a b. (a -> b) -> a -> b
    $ String
    "makeLabel for ScopedLabel: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    locnam
        labelIsVar :: ScopedLabel lb -> Bool
    labelIsVar (ScopedLabel Int
    _ lb
    lab)   = lb -> Bool
    forall lb. Label lb => lb -> Bool
    labelIsVar lb
    lab
        labelHash :: Int -> ScopedLabel lb -> Int
    labelHash Int
    seed (ScopedLabel Int
    scope lb
    lab)
            | lb -> Bool
    forall lb. Label lb => lb -> Bool
    labelIsVar lb
    lab    = Int
    seed Int -> Int -> Int
    forall a. Hashable a => Int -> a -> Int
    `hashWithSalt` Int
    scope
            | Bool
    otherwise         = Int -> lb -> Int
    forall lb. Label lb => Int -> lb -> Int
    labelHash Int
    seed lb
    lab

    instance (Label lb) => Eq (ScopedLabel lb) where
        (ScopedLabel Int
    s1 lb
    l1) == :: ScopedLabel lb -> ScopedLabel lb -> Bool
    == (ScopedLabel Int
    s2 lb
    l2)
            = lb
    l1 lb -> lb -> Bool
    forall a. Eq a => a -> a -> Bool
    == lb
    l2 Bool -> Bool -> Bool
    && Int
    s1 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    s2

    instance (Label lb) => Show (ScopedLabel lb) where
        show :: ScopedLabel lb -> String
    show (ScopedLabel Int
    s1 lb
    l1) = Int -> String
    forall a. Show a => a -> String
    show Int
    s1 String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ":" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ lb -> String
    forall a. Show a => a -> String
    show lb
    l1

    instance (Label lb) => Ord (ScopedLabel lb) where
        compare :: ScopedLabel lb -> ScopedLabel lb -> Ordering
    compare (ScopedLabel Int
    s1 lb
    l1) (ScopedLabel Int
    s2 lb
    l2) =
            case Int -> Int -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare Int
    s1 Int
    s2 of
                Ordering
    LT -> Ordering
    LT
                Ordering
    EQ -> lb -> lb -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare lb
    l1 lb
    l2
                Ordering
    GT -> Ordering
    GT

    -- QUS: why doesn't this return Maybe (LabelMap (ScopedLabel lb)) ?

    -- TODO: Should this use Set (Arc lb) instead of [Arc lb]?

    -- | Graph matching function accepting two lists of arcs and
    --  returning a node map if successful
    --
    graphMatch :: (Label lb) =>
        (lb -> lb -> Bool)
        -- ^ a function that tests for additional constraints
        --   that may prevent the matching of a supplied pair
        --   of nodes.  Returns `True` if the supplied nodes may be
        --   matched.  (Used in RDF graph matching for checking
        --   that formula assignments are compatible.)
        -> ArcSet lb -- ^ the first graph to be compared
        -> ArcSet lb -- ^ the second graph to be compared
        -> (Bool, LabelMap (ScopedLabel lb))
        -- ^ If the first element is `True` then the second element maps each label
        --   to an equivalence class identifier, otherwise it is just
        --   `emptyMap`.
        --
    graphMatch :: forall lb.
    Label lb =>
    (lb -> lb -> Bool)
    -> ArcSet lb -> ArcSet lb -> (Bool, LabelMap (ScopedLabel lb))
    graphMatch lb -> lb -> Bool
    matchable ArcSet lb
    gs1 ArcSet lb
    gs2 =
        let
            sgs1 :: Set (Arc (ScopedLabel lb))
    sgs1    = {- trace "sgs1 " $ -} (Arc lb -> Arc (ScopedLabel lb))
    -> ArcSet lb -> Set (Arc (ScopedLabel lb))
    forall b a. Ord b => (a -> b) -> Set a -> Set b
    S.map (Int -> Arc lb -> Arc (ScopedLabel lb)
    forall lb. Label lb => Int -> Arc lb -> Arc (ScopedLabel lb)
    makeScopedArc Int
    1) ArcSet lb
    gs1
            sgs2 :: Set (Arc (ScopedLabel lb))
    sgs2    = {- trace "sgs2 " $ -} (Arc lb -> Arc (ScopedLabel lb))
    -> ArcSet lb -> Set (Arc (ScopedLabel lb))
    forall b a. Ord b => (a -> b) -> Set a -> Set b
    S.map (Int -> Arc lb -> Arc (ScopedLabel lb)
    forall lb. Label lb => Int -> Arc lb -> Arc (ScopedLabel lb)
    makeScopedArc Int
    2) ArcSet lb
    gs2
            ls1 :: Set (ScopedLabel lb)
    ls1     = {- traceShow "ls1 " $ -} Set (Arc (ScopedLabel lb)) -> Set (ScopedLabel lb)
    forall lb. Label lb => ArcSet lb -> Set lb
    graphLabels Set (Arc (ScopedLabel lb))
    sgs1
            ls2 :: Set (ScopedLabel lb)
    ls2     = {- traceShow "ls2 " $ -} Set (Arc (ScopedLabel lb)) -> Set (ScopedLabel lb)
    forall lb. Label lb => ArcSet lb -> Set lb
    graphLabels Set (Arc (ScopedLabel lb))
    sgs2
            lmap :: LabelMap (ScopedLabel lb)
    lmap    = {- traceShow "lmap " $ -}
                      LabelMap (ScopedLabel lb) -> LabelMap (ScopedLabel lb)
    forall lb. Label lb => LabelMap lb -> LabelMap lb
    newGenerationMap (LabelMap (ScopedLabel lb) -> LabelMap (ScopedLabel lb))
    -> LabelMap (ScopedLabel lb) -> LabelMap (ScopedLabel lb)
    forall a b. (a -> b) -> a -> b
    $
                      Set (ScopedLabel lb)
    -> LabelMap (ScopedLabel lb) -> LabelMap (ScopedLabel lb)
    forall lb. Label lb => Set lb -> LabelMap lb -> LabelMap lb
    assignLabelMap Set (ScopedLabel lb)
    ls1 (LabelMap (ScopedLabel lb) -> LabelMap (ScopedLabel lb))
    -> LabelMap (ScopedLabel lb) -> LabelMap (ScopedLabel lb)
    forall a b. (a -> b) -> a -> b
    $
                      Set (ScopedLabel lb)
    -> LabelMap (ScopedLabel lb) -> LabelMap (ScopedLabel lb)
    forall lb. Label lb => Set lb -> LabelMap lb -> LabelMap lb
    assignLabelMap Set (ScopedLabel lb)
    ls2 LabelMap (ScopedLabel lb)
    forall lb. Label lb => LabelMap lb
    emptyMap
            ec1 :: [EquivalenceClass (ScopedLabel lb)]
    ec1     = {- traceShow "ec1 " $ -} LabelMap (ScopedLabel lb)
    -> Set (ScopedLabel lb) -> [EquivalenceClass (ScopedLabel lb)]
    forall lb.
    Label lb =>
    LabelMap lb -> Set lb -> [EquivalenceClass lb]
    equivalenceClasses LabelMap (ScopedLabel lb)
    lmap Set (ScopedLabel lb)
    ls1
            ec2 :: [EquivalenceClass (ScopedLabel lb)]
    ec2     = {- traceShow "ec2 " $ -} LabelMap (ScopedLabel lb)
    -> Set (ScopedLabel lb) -> [EquivalenceClass (ScopedLabel lb)]
    forall lb.
    Label lb =>
    LabelMap lb -> Set lb -> [EquivalenceClass lb]
    equivalenceClasses LabelMap (ScopedLabel lb)
    lmap Set (ScopedLabel lb)
    ls2
            ecpairs :: [(EquivalenceClass (ScopedLabel lb),
      EquivalenceClass (ScopedLabel lb))]
    ecpairs = [EquivalenceClass (ScopedLabel lb)]
    -> [EquivalenceClass (ScopedLabel lb)]
    -> [(EquivalenceClass (ScopedLabel lb),
         EquivalenceClass (ScopedLabel lb))]
    forall a b. [a] -> [b] -> [(a, b)]
    zip ([EquivalenceClass (ScopedLabel lb)]
    -> [EquivalenceClass (ScopedLabel lb)]
    forall a b. Ord a => [(a, b)] -> [(a, b)]
    pairSort [EquivalenceClass (ScopedLabel lb)]
    ec1) ([EquivalenceClass (ScopedLabel lb)]
    -> [EquivalenceClass (ScopedLabel lb)]
    forall a b. Ord a => [(a, b)] -> [(a, b)]
    pairSort [EquivalenceClass (ScopedLabel lb)]
    ec2)
            matchableScoped :: ScopedLabel lb -> ScopedLabel lb -> Bool
    matchableScoped (ScopedLabel Int
    _ lb
    l1) (ScopedLabel Int
    _ lb
    l2) = lb -> lb -> Bool
    matchable lb
    l1 lb
    l2
            match :: (Bool, LabelMap (ScopedLabel lb))
    match   = Bool
    -> (ScopedLabel lb -> ScopedLabel lb -> Bool)
    -> Set (Arc (ScopedLabel lb))
    -> Set (Arc (ScopedLabel lb))
    -> LabelMap (ScopedLabel lb)
    -> [(EquivalenceClass (ScopedLabel lb),
         EquivalenceClass (ScopedLabel lb))]
    -> (Bool, LabelMap (ScopedLabel lb))
    forall lb.
    Label lb =>
    Bool
    -> (lb -> lb -> Bool)
    -> ArcSet lb
    -> ArcSet lb
    -> LabelMap lb
    -> [(EquivalenceClass lb, EquivalenceClass lb)]
    -> (Bool, LabelMap lb)
    graphMatch1 Bool
    False ScopedLabel lb -> ScopedLabel lb -> Bool
    matchableScoped Set (Arc (ScopedLabel lb))
    sgs1 Set (Arc (ScopedLabel lb))
    sgs2 LabelMap (ScopedLabel lb)
    lmap [(EquivalenceClass (ScopedLabel lb),
      EquivalenceClass (ScopedLabel lb))]
    ecpairs
        in
            if [EquivalenceClass (ScopedLabel lb)] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [EquivalenceClass (ScopedLabel lb)]
    ec1 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= [EquivalenceClass (ScopedLabel lb)] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [EquivalenceClass (ScopedLabel lb)]
    ec2 then (Bool
    False,LabelMap (ScopedLabel lb)
    forall lb. Label lb => LabelMap lb
    emptyMap) else (Bool, LabelMap (ScopedLabel lb))
    match

    --  TODO:
    --
    --    * replace Equivalence class pair by @(index,[lb],[lb])@ ?
    --
    --    * possible optimization:  the @graphMapEq@ test should be
    --      needed only if `graphMatch2` has been used to guess a
    --      mapping;  either:
    --          a) supply flag saying guess has been used, or
    --          b) move test to `graphMatch2` and use different
    --             test to prevent rechecking for each guess used.
    --

    -- | Recursive graph matching function
    --
    --  This function assumes that no variable label appears in both graphs.
    --  (Function `graphMatch`, which calls this, ensures that all variable
    --  labels are distinct.)
    --

    graphMatch1 ::
      (Label lb)
      => Bool
      -- ^ `True` if a guess has been used before trying this comparison,
      --   `False` if nodes are being matched without any guesswork
      -> (lb -> lb -> Bool)
      -- ^ Test for additional constraints that may prevent the matching
      --  of a supplied pair of nodes.  Returns `True` if the supplied
      --  nodes may be matched.
      -> ArcSet lb
      -- ^ (@gs1@ argument)
      --   first of two lists of arcs (triples) to be compared
      -> ArcSet lb
      -- ^ (@gs2@ argument)
      --   secind of two lists of arcs (triples) to be compared
      -> LabelMap lb
      -- ^ the map so far used to map label values to equivalence class
      --   values
      -> [(EquivalenceClass lb,EquivalenceClass lb)]
      -- ^ (the @ecpairs@ argument) list of pairs of corresponding
      --   equivalence classes of nodes from @gs1@ and @gs2@ that have not
      --   been confirmed in 1:1 correspondence with each other.  Each
      --   pair of equivalence classes contains nodes that must be placed
      --   in 1:1 correspondence with each other.
      --
      -> (Bool,LabelMap lb)
      -- ^ the pair @(match, map)@ where @match@ is @True@ if the supplied
      --   sets of arcs can be matched, in which case @map@ is a
      --   corresponding map from labels to equivalence class identifiers.
      --   When @match@ is @False@, @map@ is the most detailed equivalence
      --   class map obtained before a mismatch was detected or a guess
      --   was required -- this is intended to help identify where the
      --   graph mismatch may be.
    graphMatch1 :: forall lb.
    Label lb =>
    Bool
    -> (lb -> lb -> Bool)
    -> ArcSet lb
    -> ArcSet lb
    -> LabelMap lb
    -> [(EquivalenceClass lb, EquivalenceClass lb)]
    -> (Bool, LabelMap lb)
    graphMatch1 Bool
    guessed lb -> lb -> Bool
    matchable ArcSet lb
    gs1 ArcSet lb
    gs2 LabelMap lb
    lmap [(EquivalenceClass lb, EquivalenceClass lb)]
    ecpairs =
        let
            ([(EquivalenceClass lb, EquivalenceClass lb)]
    secs,[(EquivalenceClass lb, EquivalenceClass lb)]
    mecs) = ((EquivalenceClass lb, EquivalenceClass lb) -> Bool)
    -> [(EquivalenceClass lb, EquivalenceClass lb)]
    -> ([(EquivalenceClass lb, EquivalenceClass lb)],
        [(EquivalenceClass lb, EquivalenceClass lb)])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition (EquivalenceClass lb, EquivalenceClass lb) -> Bool
    forall {a} {a} {a} {a}. ((a, [a]), (a, [a])) -> Bool
    uniqueEc [(EquivalenceClass lb, EquivalenceClass lb)]
    ecpairs
            uniqueEc :: ((a, [a]), (a, [a])) -> Bool
    uniqueEc ( (a
    _,[a
    _])  , (a
    _,[a
    _])  ) = Bool
    True
            uniqueEc (  (a, [a])
    _       ,  (a, [a])
    _       ) = Bool
    False

            doMatch :: ((a, [lb]), (a, [lb])) -> Bool
    doMatch  ( (a
    _,[lb
    l1]) , (a
    _,[lb
    l2]) ) = (lb -> lb -> Bool) -> LabelMap lb -> lb -> lb -> Bool
    forall lb.
    Label lb =>
    (lb -> lb -> Bool) -> LabelMap lb -> lb -> lb -> Bool
    labelMatch lb -> lb -> Bool
    matchable LabelMap lb
    lmap lb
    l1 lb
    l2
            doMatch  ((a, [lb]), (a, [lb]))
    x = String -> Bool
    forall a. HasCallStack => String -> a
    error (String -> Bool) -> String -> Bool
    forall a b. (a -> b) -> a -> b
    $ String
    "doMatch failue: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ((a, [lb]), (a, [lb])) -> String
    forall a. Show a => a -> String
    show ((a, [lb]), (a, [lb]))
    x -- keep -Wall happy

            ecEqSize :: ((a, t a), (a, t a)) -> Bool
    ecEqSize ( (a
    _,t a
    ls1)  , (a
    _,t a
    ls2)  ) = t a -> Int
    forall a. t a -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length t a
    ls1 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == t a -> Int
    forall a. t a -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length t a
    ls2
            eSize :: ((a, t a), b) -> Int
    eSize    ( (a
    _,t a
    ls1)  , b
    _        ) = t a -> Int
    forall a. t a -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length t a
    ls1
            ecCompareSize :: ((a, [a]), b) -> ((a, [a]), b) -> Ordering
    ecCompareSize = (((a, [a]), b) -> Int)
    -> ((a, [a]), b) -> ((a, [a]), b) -> Ordering
    forall a b. Ord a => (b -> a) -> b -> b -> Ordering
    comparing ((a, [a]), b) -> Int
    forall {t :: * -> *} {a} {a} {b}.
    Foldable t =>
    ((a, t a), b) -> Int
    eSize
            (LabelMap lb
    lmap',[(EquivalenceClass lb, EquivalenceClass lb)]
    mecs',Bool
    newEc,Bool
    matchEc) = ArcSet lb
    -> ArcSet lb
    -> LabelMap lb
    -> [(EquivalenceClass lb, EquivalenceClass lb)]
    -> (LabelMap lb, [(EquivalenceClass lb, EquivalenceClass lb)],
        Bool, Bool)
    forall lb.
    Label lb =>
    ArcSet lb
    -> ArcSet lb
    -> LabelMap lb
    -> [(EquivalenceClass lb, EquivalenceClass lb)]
    -> (LabelMap lb, [(EquivalenceClass lb, EquivalenceClass lb)],
        Bool, Bool)
    reclassify ArcSet lb
    gs1 ArcSet lb
    gs2 LabelMap lb
    lmap [(EquivalenceClass lb, EquivalenceClass lb)]
    mecs
            match2 :: (Bool, LabelMap lb)
    match2 = (lb -> lb -> Bool)
    -> ArcSet lb
    -> ArcSet lb
    -> LabelMap lb
    -> [(EquivalenceClass lb, EquivalenceClass lb)]
    -> (Bool, LabelMap lb)
    forall lb.
    Label lb =>
    (lb -> lb -> Bool)
    -> ArcSet lb
    -> ArcSet lb
    -> LabelMap lb
    -> [(EquivalenceClass lb, EquivalenceClass lb)]
    -> (Bool, LabelMap lb)
    graphMatch2 lb -> lb -> Bool
    matchable ArcSet lb
    gs1 ArcSet lb
    gs2 LabelMap lb
    lmap ([(EquivalenceClass lb, EquivalenceClass lb)]
     -> (Bool, LabelMap lb))
    -> [(EquivalenceClass lb, EquivalenceClass lb)]
    -> (Bool, LabelMap lb)
    forall a b. (a -> b) -> a -> b
    $ ((EquivalenceClass lb, EquivalenceClass lb)
     -> (EquivalenceClass lb, EquivalenceClass lb) -> Ordering)
    -> [(EquivalenceClass lb, EquivalenceClass lb)]
    -> [(EquivalenceClass lb, EquivalenceClass lb)]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy (EquivalenceClass lb, EquivalenceClass lb)
    -> (EquivalenceClass lb, EquivalenceClass lb) -> Ordering
    forall {a} {a} {b}. ((a, [a]), b) -> ((a, [a]), b) -> Ordering
    ecCompareSize [(EquivalenceClass lb, EquivalenceClass lb)]
    mecs
        in
            -- trace ("graphMatch1\nsingle ECs:\n"++show secs++
            --                   "\nmultiple ECs:\n"++show mecs++
            --                   "\n\n") $
            --  if mismatch in singleton equivalence classes, fail
            if Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ ((EquivalenceClass lb, EquivalenceClass lb) -> Bool)
    -> [(EquivalenceClass lb, EquivalenceClass lb)] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (EquivalenceClass lb, EquivalenceClass lb) -> Bool
    forall {a} {a}. (Show a, Show a) => ((a, [lb]), (a, [lb])) -> Bool
    doMatch [(EquivalenceClass lb, EquivalenceClass lb)]
    secs then (Bool
    False,LabelMap lb
    lmap)
            else
            --  if no multi-member equivalence classes,
            --  check and return label map supplied
            -- trace ("graphMatch1\ngraphMapEq: "++show (graphMapEq lmap gs1 gs2)) $
            if [(EquivalenceClass lb, EquivalenceClass lb)] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(EquivalenceClass lb, EquivalenceClass lb)]
    mecs then (LabelMap lb -> ArcSet lb -> ArcSet lb -> Bool
    forall lb.
    Label lb =>
    LabelMap lb -> ArcSet lb -> ArcSet lb -> Bool
    graphMapEq LabelMap lb
    lmap ArcSet lb
    gs1 ArcSet lb
    gs2,LabelMap lb
    lmap)
            else
            --  if size mismatch in equivalence classes, fail
            -- trace ("graphMatch1\nall ecEqSize mecs: "++show (all ecEqSize mecs)) $

              --  invoke reclassification, and deal with result
              if Bool -> Bool
    not (((EquivalenceClass lb, EquivalenceClass lb) -> Bool)
    -> [(EquivalenceClass lb, EquivalenceClass lb)] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (EquivalenceClass lb, EquivalenceClass lb) -> Bool
    forall {t :: * -> *} {t :: * -> *} {a} {a} {a} {a}.
    (Foldable t, Foldable t) =>
    ((a, t a), (a, t a)) -> Bool
    ecEqSize [(EquivalenceClass lb, EquivalenceClass lb)]
    mecs) Bool -> Bool -> Bool
    || Bool -> Bool
    not Bool
    matchEc
                then (Bool
    False, LabelMap lb
    lmap)
                else if Bool
    newEc
                       then Bool
    -> (lb -> lb -> Bool)
    -> ArcSet lb
    -> ArcSet lb
    -> LabelMap lb
    -> [(EquivalenceClass lb, EquivalenceClass lb)]
    -> (Bool, LabelMap lb)
    forall lb.
    Label lb =>
    Bool
    -> (lb -> lb -> Bool)
    -> ArcSet lb
    -> ArcSet lb
    -> LabelMap lb
    -> [(EquivalenceClass lb, EquivalenceClass lb)]
    -> (Bool, LabelMap lb)
    graphMatch1 Bool
    guessed lb -> lb -> Bool
    matchable ArcSet lb
    gs1 ArcSet lb
    gs2 LabelMap lb
    lmap' [(EquivalenceClass lb, EquivalenceClass lb)]
    mecs'
                            --  if guess does not result in a match, return supplied label map
                       else if (Bool, LabelMap lb) -> Bool
    forall a b. (a, b) -> a
    fst (Bool, LabelMap lb)
    match2 then (Bool, LabelMap lb)
    match2 else (Bool
    False, LabelMap lb
    lmap)

    {-
              if not $ all ecEqSize mecs then (False,lmap)
            else
            if not matchEc then (False,lmap)
            else
            if newEc then graphMatch1 guessed matchable gs1 gs2 lmap' mecs'
            else
            if fst match2 then match2 else (False,lmap)
    -}

    -- | Auxiliary graph matching function
    --
    --  This function is called when deterministic decomposition of node
    --  mapping equivalence classes has run its course.
    --
    --  It picks a pair of equivalence classes in ecpairs, and arbitrarily matches
    --  pairs of nodes in those equivalence classes, recursively calling the
    --  graph matching function until a suitable node mapping is discovered
    --  (success), or until all such pairs have been tried (failure).
    --
    --  This function represents a point to which arbitrary choices are backtracked.
    --  The list comprehension 'glp' represents the alternative choices at the
    --  point of backtracking
    --
    --  The selected pair of nodes are placed in a new equivalence class based on their
    --  original equivalence class value, but with a new NodeVal generation number.

    graphMatch2 :: (Label lb) => (lb -> lb -> Bool)
        -> ArcSet lb
        -> ArcSet lb
        -> LabelMap lb
        -> [(EquivalenceClass lb,EquivalenceClass lb)]
        -> (Bool,LabelMap lb)
    graphMatch2 :: forall lb.
    Label lb =>
    (lb -> lb -> Bool)
    -> ArcSet lb
    -> ArcSet lb
    -> LabelMap lb
    -> [(EquivalenceClass lb, EquivalenceClass lb)]
    -> (Bool, LabelMap lb)
    graphMatch2 lb -> lb -> Bool
    _         ArcSet lb
    _   ArcSet lb
    _   LabelMap lb
    _    [] = String -> (Bool, LabelMap lb)
    forall a. HasCallStack => String -> a
    error String
    "graphMatch2 sent an empty list" -- To keep -Wall happy
    graphMatch2 lb -> lb -> Bool
    matchable ArcSet lb
    gs1 ArcSet lb
    gs2 LabelMap lb
    lmap ((ec1 :: EquivalenceClass lb
    ec1@(LabelIndex
    ev1,[lb]
    ls1),ec2 :: EquivalenceClass lb
    ec2@(LabelIndex
    ev2,[lb]
    ls2)):[(EquivalenceClass lb, EquivalenceClass lb)]
    ecpairs) =
        let
            v1 :: Word32
    v1 = LabelIndex -> Word32
    forall a b. (a, b) -> b
    snd LabelIndex
    ev1
            --  Return any equivalence-mapping obtained by matching a pair
            --  of labels in the supplied list, or Nothing.
            try :: [(lb, lb)] -> (Bool, LabelMap lb)
    try []            = (Bool
    False,LabelMap lb
    lmap)
            try ((lb
    l1,lb
    l2):[(lb, lb)]
    lps) = if (Bool, LabelMap lb) -> lb -> lb -> Bool
    isEquiv (Bool, LabelMap lb)
    try1 lb
    l1 lb
    l2 then (Bool, LabelMap lb)
    try1 else [(lb, lb)] -> (Bool, LabelMap lb)
    try [(lb, lb)]
    lps
                where
                    try1 :: (Bool, LabelMap lb)
    try1     = Bool
    -> (lb -> lb -> Bool)
    -> ArcSet lb
    -> ArcSet lb
    -> LabelMap lb
    -> [(EquivalenceClass lb, EquivalenceClass lb)]
    -> (Bool, LabelMap lb)
    forall lb.
    Label lb =>
    Bool
    -> (lb -> lb -> Bool)
    -> ArcSet lb
    -> ArcSet lb
    -> LabelMap lb
    -> [(EquivalenceClass lb, EquivalenceClass lb)]
    -> (Bool, LabelMap lb)
    graphMatch1 Bool
    True lb -> lb -> Bool
    matchable ArcSet lb
    gs1 ArcSet lb
    gs2 LabelMap lb
    lmap' [(EquivalenceClass lb, EquivalenceClass lb)]
    ecpairs'
                    lmap' :: LabelMap lb
    lmap'    = LabelMap lb -> [(lb, Word32)] -> LabelMap lb
    forall lb. Label lb => LabelMap lb -> [(lb, Word32)] -> LabelMap lb
    newLabelMap LabelMap lb
    lmap [(lb
    l1,Word32
    v1),(lb
    l2,Word32
    v1)]
                    ecpairs' :: [(EquivalenceClass lb, EquivalenceClass lb)]
    ecpairs' = ((LabelIndex
    ev',[lb
    l1]),(LabelIndex
    ev',[lb
    l2]))(EquivalenceClass lb, EquivalenceClass lb)
    -> [(EquivalenceClass lb, EquivalenceClass lb)]
    -> [(EquivalenceClass lb, EquivalenceClass lb)]
    forall a. a -> [a] -> [a]
    :(EquivalenceClass lb, EquivalenceClass lb)
    ec'(EquivalenceClass lb, EquivalenceClass lb)
    -> [(EquivalenceClass lb, EquivalenceClass lb)]
    -> [(EquivalenceClass lb, EquivalenceClass lb)]
    forall a. a -> [a] -> [a]
    :[(EquivalenceClass lb, EquivalenceClass lb)]
    ecpairs
                    ev' :: LabelIndex
    ev'      = LabelMap lb -> lb -> LabelIndex
    forall lb. Label lb => LabelMap lb -> lb -> LabelIndex
    mapLabelIndex LabelMap lb
    lmap' lb
    l1
                    ec' :: (EquivalenceClass lb, EquivalenceClass lb)
    ec'      = (EquivalenceClass lb -> lb -> EquivalenceClass lb
    forall lb.
    Label lb =>
    EquivalenceClass lb -> lb -> EquivalenceClass lb
    ecRemoveLabel EquivalenceClass lb
    ec1 lb
    l1, EquivalenceClass lb -> lb -> EquivalenceClass lb
    forall lb.
    Label lb =>
    EquivalenceClass lb -> lb -> EquivalenceClass lb
    ecRemoveLabel EquivalenceClass lb
    ec2 lb
    l2)
                    -- [[[TODO: replace this: if isJust try ?]]]
                    isEquiv :: (Bool, LabelMap lb) -> lb -> lb -> Bool
    isEquiv (Bool
    False,LabelMap lb
    _)   lb
    _  lb
    _  = Bool
    False
                    isEquiv (Bool
    True,LabelMap lb
    lm) lb
    x1 lb
    x2 =
                        LabelMap lb -> lb -> LabelIndex
    forall lb. Label lb => LabelMap lb -> lb -> LabelIndex
    mapLabelIndex LabelMap lb
    m1 lb
    x1 LabelIndex -> LabelIndex -> Bool
    forall a. Eq a => a -> a -> Bool
    == LabelMap lb -> lb -> LabelIndex
    forall lb. Label lb => LabelMap lb -> lb -> LabelIndex
    mapLabelIndex LabelMap lb
    m2 lb
    x2
                        where
                            m1 :: LabelMap lb
    m1 = ArcSet lb -> LabelMap lb -> [lb] -> LabelMap lb
    forall lb.
    Label lb =>
    ArcSet lb -> LabelMap lb -> [lb] -> LabelMap lb
    remapLabels ArcSet lb
    gs1 LabelMap lb
    lm [lb
    x1]
                            m2 :: LabelMap lb
    m2 = ArcSet lb -> LabelMap lb -> [lb] -> LabelMap lb
    forall lb.
    Label lb =>
    ArcSet lb -> LabelMap lb -> [lb] -> LabelMap lb
    remapLabels ArcSet lb
    gs2 LabelMap lb
    lm [lb
    x2]
            --  glp is a list of label-pair candidates for matching,
            --  selected from the first label-equivalence class.
            --  NOTE:  final test is call of external matchable function
            glp :: [(lb, lb)]
    glp = [ (lb
    l1,lb
    l2) | lb
    l1 <- [lb]
    ls1 , lb
    l2 <- [lb]
    ls2 , lb -> lb -> Bool
    matchable lb
    l1 lb
    l2 ]
        in
            Bool -> (Bool, LabelMap lb) -> (Bool, LabelMap lb)
    forall a. HasCallStack => Bool -> a -> a
    assert (LabelIndex
    ev1 LabelIndex -> LabelIndex -> Bool
    forall a. Eq a => a -> a -> Bool
    == LabelIndex
    ev2) -- "GraphMatch2: Equivalence class value mismatch" $
            ((Bool, LabelMap lb) -> (Bool, LabelMap lb))
    -> (Bool, LabelMap lb) -> (Bool, LabelMap lb)
    forall a b. (a -> b) -> a -> b
    $ [(lb, lb)] -> (Bool, LabelMap lb)
    try [(lb, lb)]
    glp

    -- this was in Swish.Utils.MiscHelpers along with a simple hash-based function
    -- based on Sedgewick, Algorithms in C, p233. As we have now moved to using
    -- Data.Hashable it is not clear whether this is still necessary or sensible.
    --
    hashModulus :: Int
    hashModulus :: Int
    hashModulus = Int
    16000001

    -- | Returns a string representation  of a LabelMap value
    --
    showLabelMap :: (Label lb) => LabelMap lb -> String
    showLabelMap :: forall lb. Label lb => LabelMap lb -> String
    showLabelMap (LabelMap Word32
    gn Map lb LabelIndex
    lmap) =
        String
    "LabelMap gen=" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Word32 -> String
    forall a. Show a => a -> String
    Prelude.show Word32
    gn String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ", map=" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
        (String -> ShowS) -> String -> [String] -> String
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' String -> ShowS
    forall a. [a] -> [a] -> [a]
    (++) String
    "" (((lb, LabelIndex) -> String) -> [(lb, LabelIndex)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map ((String
    "\n    " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++) ShowS -> ((lb, LabelIndex) -> String) -> (lb, LabelIndex) -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (lb, LabelIndex) -> String
    forall a. Show a => a -> String
    Prelude.show) [(lb, LabelIndex)]
    es)
        where
            es :: [(lb, LabelIndex)]
    es = Map lb LabelIndex -> [(lb, LabelIndex)]
    forall k a. Map k a -> [(k, a)]
    M.toList Map lb LabelIndex
    lmap

    -- | Map a label to its corresponding label index value in the
    --   supplied LabelMap.
    --
    mapLabelIndex :: (Label lb) => LabelMap lb -> lb -> LabelIndex
    mapLabelIndex :: forall lb. Label lb => LabelMap lb -> lb -> LabelIndex
    mapLabelIndex (LabelMap Word32
    _ Map lb LabelIndex
    lxms) lb
    lb = LabelIndex -> lb -> Map lb LabelIndex -> LabelIndex
    forall k a. Ord k => a -> k -> Map k a -> a
    M.findWithDefault LabelIndex
    nullLabelVal lb
    lb Map lb LabelIndex
    lxms

    -- | Confirm that a given pair of labels are matchable, and are
    --  mapped to the same value by the supplied label map
    --
    labelMatch :: (Label lb)
        =>  (lb -> lb -> Bool) -> LabelMap lb -> lb -> lb -> Bool
    labelMatch :: forall lb.
    Label lb =>
    (lb -> lb -> Bool) -> LabelMap lb -> lb -> lb -> Bool
    labelMatch lb -> lb -> Bool
    matchable LabelMap lb
    lmap lb
    l1 lb
    l2 =
        lb -> lb -> Bool
    matchable lb
    l1 lb
    l2 Bool -> Bool -> Bool
    && (LabelMap lb -> lb -> LabelIndex
    forall lb. Label lb => LabelMap lb -> lb -> LabelIndex
    mapLabelIndex LabelMap lb
    lmap lb
    l1 LabelIndex -> LabelIndex -> Bool
    forall a. Eq a => a -> a -> Bool
    == LabelMap lb -> lb -> LabelIndex
    forall lb. Label lb => LabelMap lb -> lb -> LabelIndex
    mapLabelIndex LabelMap lb
    lmap lb
    l2)

    -- | Replace selected values in a label map with new values from the supplied
    --  list of labels and new label index values.  The generation number is
    --  supplied from the current label map.  The generation number in the
    --  resulting label map is incremented.
    --
    newLabelMap :: (Label lb) => LabelMap lb -> [(lb, Word32)] -> LabelMap lb
    newLabelMap :: forall lb. Label lb => LabelMap lb -> [(lb, Word32)] -> LabelMap lb
    newLabelMap LabelMap lb
    lmap []       = LabelMap lb -> LabelMap lb
    forall lb. Label lb => LabelMap lb -> LabelMap lb
    newGenerationMap LabelMap lb
    lmap
    newLabelMap LabelMap lb
    lmap ((lb, Word32)
    lv:[(lb, Word32)]
    lvs) = LabelMap lb -> (lb, Word32) -> LabelMap lb
    forall lb. Label lb => LabelMap lb -> (lb, Word32) -> LabelMap lb
    setLabelHash (LabelMap lb -> [(lb, Word32)] -> LabelMap lb
    forall lb. Label lb => LabelMap lb -> [(lb, Word32)] -> LabelMap lb
    newLabelMap LabelMap lb
    lmap [(lb, Word32)]
    lvs) (lb, Word32)
    lv

    -- | Replace a label and its associated value in a label map
    --  with a new value using the supplied hash value and the current
    --  `LabelMap` generation number.  If the key is not found, then no change
    --  is made to the label map.

    setLabelHash :: (Label lb)
        => LabelMap lb -> (lb, Word32) -> LabelMap lb
    setLabelHash :: forall lb. Label lb => LabelMap lb -> (lb, Word32) -> LabelMap lb
    setLabelHash  (LabelMap Word32
    g Map lb LabelIndex
    lmap) (lb
    lb,Word32
    lh) =
        Word32 -> Map lb LabelIndex -> GenLabelMap lb LabelIndex
    forall lb lv.
    (Label lb, Eq lv, Show lv) =>
    Word32 -> Map lb lv -> GenLabelMap lb lv
    LabelMap Word32
    g (Map lb LabelIndex -> GenLabelMap lb LabelIndex)
    -> Map lb LabelIndex -> GenLabelMap lb LabelIndex
    forall a b. (a -> b) -> a -> b
    $ lb -> LabelIndex -> Map lb LabelIndex -> Map lb LabelIndex
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert lb
    lb (Word32
    g,Word32
    lh) Map lb LabelIndex
    lmap

    -- | Increment the generation of the label map.
    --
    --  Returns a new label map identical to the supplied value
    --  but with an incremented generation number.
    --
    newGenerationMap :: (Label lb) => LabelMap lb -> LabelMap lb
    newGenerationMap :: forall lb. Label lb => LabelMap lb -> LabelMap lb
    newGenerationMap (LabelMap Word32
    g Map lb LabelIndex
    lvs) = Word32 -> Map lb LabelIndex -> GenLabelMap lb LabelIndex
    forall lb lv.
    (Label lb, Eq lv, Show lv) =>
    Word32 -> Map lb lv -> GenLabelMap lb lv
    LabelMap (Word32
    g Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    + Word32
    1) Map lb LabelIndex
    lvs

    -- | Scan label list, assigning initial label map values,
    --  adding new values to the label map supplied.
    --
    --  Label map values are assigned on the basis of the
    --  label alone, without regard for it's connectivity in
    --  the graph.  (cf. `reclassify`).
    --
    --  All variable node labels are assigned the same initial
    --  value, as they may be matched with each other.
    --
    assignLabelMap :: (Label lb) => S.Set lb -> LabelMap lb -> LabelMap lb
    assignLabelMap :: forall lb. Label lb => Set lb -> LabelMap lb -> LabelMap lb
    assignLabelMap Set lb
    ns LabelMap lb
    lmap = (LabelMap lb -> lb -> LabelMap lb)
    -> LabelMap lb -> Set lb -> LabelMap lb
    forall a b. (a -> b -> a) -> a -> Set b -> a
    S.foldl' ((lb -> LabelMap lb -> LabelMap lb)
    -> LabelMap lb -> lb -> LabelMap lb
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip lb -> LabelMap lb -> LabelMap lb
    forall lb. Label lb => lb -> LabelMap lb -> LabelMap lb
    assignLabelMap1) LabelMap lb
    lmap Set lb
    ns

    assignLabelMap1 :: (Label lb) => lb -> LabelMap lb -> LabelMap lb
    assignLabelMap1 :: forall lb. Label lb => lb -> LabelMap lb -> LabelMap lb
    assignLabelMap1 lb
    lab (LabelMap Word32
    g Map lb LabelIndex
    lvs) =
        Word32 -> Map lb LabelIndex -> GenLabelMap lb LabelIndex
    forall lb lv.
    (Label lb, Eq lv, Show lv) =>
    Word32 -> Map lb lv -> GenLabelMap lb lv
    LabelMap Word32
    g (Map lb LabelIndex -> GenLabelMap lb LabelIndex)
    -> Map lb LabelIndex -> GenLabelMap lb LabelIndex
    forall a b. (a -> b) -> a -> b
    $ (LabelIndex -> LabelIndex -> LabelIndex)
    -> lb -> LabelIndex -> Map lb LabelIndex -> Map lb LabelIndex
    forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
    M.insertWith ((LabelIndex -> LabelIndex)
    -> LabelIndex -> LabelIndex -> LabelIndex
    forall a b. a -> b -> a
    const LabelIndex -> LabelIndex
    forall a. a -> a
    id) lb
    lab (Word32
    g, lb -> Word32
    forall lb. Label lb => lb -> Word32
    initVal lb
    lab) Map lb LabelIndex
    lvs

    --  Calculate initial value for a node

    initVal :: (Label lb) => lb -> Word32
    initVal :: forall lb. Label lb => lb -> Word32
    initVal = Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word32) -> (lb -> Int) -> lb -> Word32
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word32 -> lb -> Int
    forall lb. Label lb => Word32 -> lb -> Int
    hashVal Word32
    0

    hashVal :: (Label lb) => Word32 -> lb -> Int
    hashVal :: forall lb. Label lb => Word32 -> lb -> Int
    hashVal Word32
    seed lb
    lab =
      if lb -> Bool
    forall lb. Label lb => lb -> Bool
    labelIsVar lb
    lab then Int
    23 Int -> Word32 -> Int
    forall a. Hashable a => Int -> a -> Int
    `hashWithSalt` Word32
    seed else Int -> lb -> Int
    forall lb. Label lb => Int -> lb -> Int
    labelHash (Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word32
    seed) lb
    lab

    -- | Return the equivalence classes of the supplied nodes
    -- using the label map.
    equivalenceClasses ::
      (Label lb)
      => LabelMap lb     -- ^ label map
      -> S.Set lb        -- ^ nodes to be reclassified
      -> [EquivalenceClass lb]
    equivalenceClasses :: forall lb.
    Label lb =>
    LabelMap lb -> Set lb -> [EquivalenceClass lb]
    equivalenceClasses LabelMap lb
    lmap Set lb
    ls =
        [(LabelIndex, lb)] -> [(LabelIndex, [lb])]
    forall a b. Ord a => [(a, b)] -> [(a, [b])]
    pairGroup ([(LabelIndex, lb)] -> [(LabelIndex, [lb])])
    -> [(LabelIndex, lb)] -> [(LabelIndex, [lb])]
    forall a b. (a -> b) -> a -> b
    $ Set (LabelIndex, lb) -> [(LabelIndex, lb)]
    forall a. Set a -> [a]
    S.toList (Set (LabelIndex, lb) -> [(LabelIndex, lb)])
    -> Set (LabelIndex, lb) -> [(LabelIndex, lb)]
    forall a b. (a -> b) -> a -> b
    $ (lb -> (LabelIndex, lb)) -> Set lb -> Set (LabelIndex, lb)
    forall b a. Ord b => (a -> b) -> Set a -> Set b
    S.map lb -> (LabelIndex, lb)
    labelPair Set lb
    ls
        where
            labelPair :: lb -> (LabelIndex, lb)
    labelPair lb
    l = (LabelMap lb -> lb -> LabelIndex
    forall lb. Label lb => LabelMap lb -> lb -> LabelIndex
    mapLabelIndex LabelMap lb
    lmap lb
    l,lb
    l)

    -- | Reclassify labels
    --
    --  Examines the supplied label equivalence classes (based on the supplied
    --  label map), and evaluates new equivalence subclasses based on node
    --  values and adjacency (for variable nodes) and rehashing
    --  (for non-variable nodes).
    --
    --  Note, assumes that all all equivalence classes supplied are
    --  non-singletons;  i.e. contain more than one label.
    --
    reclassify ::
      (Label lb)
      => ArcSet lb
      -- ^ (the @gs1@ argument) the first of two sets of arcs to perform a
      --   basis for reclassifying the labels in the first equivalence
      --   class in each pair of @ecpairs@.
      -> ArcSet lb
      -- ^ (the @gs2@ argument) the second of two sets of arcs to perform a
      --   basis for reclassifying the labels in the second equivalence
      --   class in each pair of the @ecpairs@ argument
      -> LabelMap lb
      -- ^ the label map used for classification of the labels in
      --   the supplied equivalence classes
      -> [(EquivalenceClass lb,EquivalenceClass lb)]
      -- ^ (the @ecpairs@ argument) a list of pairs of corresponding equivalence classes of
      --   nodes from @gs1@ and @gs2@ that have not been confirmed
      --   in 1:1 correspondence with each other.
      -> (LabelMap lb,[(EquivalenceClass lb,EquivalenceClass lb)],Bool,Bool)
      -- ^ The output tuple consists of:
      --
      --  1) a revised label map reflecting the reclassification
      --
      --  2) a new list of equivalence class pairs based on the
      --   new node map
      --
      --  3) if the reclassification partitions any of the
      --     supplied equivalence classes then `True`, else `False`
      --
      --  4) if reclassification results in each equivalence class
      --     being split same-sized equivalence classes in the two graphs,
      --     then `True`, otherwise `False`.

    reclassify :: forall lb.
    Label lb =>
    ArcSet lb
    -> ArcSet lb
    -> LabelMap lb
    -> [(EquivalenceClass lb, EquivalenceClass lb)]
    -> (LabelMap lb, [(EquivalenceClass lb, EquivalenceClass lb)],
        Bool, Bool)
    reclassify ArcSet lb
    gs1 ArcSet lb
    gs2 lmap :: LabelMap lb
    lmap@(LabelMap Word32
    _ Map lb LabelIndex
    lm) [(EquivalenceClass lb, EquivalenceClass lb)]
    ecpairs =
        Bool
    -> (LabelMap lb, [(EquivalenceClass lb, EquivalenceClass lb)],
        Bool, Bool)
    -> (LabelMap lb, [(EquivalenceClass lb, EquivalenceClass lb)],
        Bool, Bool)
    forall a. HasCallStack => Bool -> a -> a
    assert (Word32
    gen1 Word32 -> Word32 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word32
    gen2) -- "Label map generation mismatch"
          (Word32 -> Map lb LabelIndex -> LabelMap lb
    forall lb lv.
    (Label lb, Eq lv, Show lv) =>
    Word32 -> Map lb lv -> GenLabelMap lb lv
    LabelMap Word32
    gen1 Map lb LabelIndex
    lm',[(EquivalenceClass lb, EquivalenceClass lb)]
    ecpairs',Bool
    newPart,Bool
    matchPart)
        where
            LabelMap Word32
    gen1 Map lb LabelIndex
    lm1 =
                ArcSet lb -> LabelMap lb -> [lb] -> LabelMap lb
    forall lb.
    Label lb =>
    ArcSet lb -> LabelMap lb -> [lb] -> LabelMap lb
    remapLabels ArcSet lb
    gs1 LabelMap lb
    lmap ([lb] -> LabelMap lb) -> [lb] -> LabelMap lb
    forall a b. (a -> b) -> a -> b
    $ ([lb] -> [lb] -> [lb]) -> [[lb]] -> [lb]
    forall a. (a -> a -> a) -> [a] -> a
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldl1 [lb] -> [lb] -> [lb]
    forall a. [a] -> [a] -> [a]
    (++) ([[lb]] -> [lb]) -> [[lb]] -> [lb]
    forall a b. (a -> b) -> a -> b
    $ ((EquivalenceClass lb, EquivalenceClass lb) -> [lb])
    -> [(EquivalenceClass lb, EquivalenceClass lb)] -> [[lb]]
    forall a b. (a -> b) -> [a] -> [b]
    map (EquivalenceClass lb -> [lb]
    forall lb. EquivalenceClass lb -> [lb]
    ecLabels (EquivalenceClass lb -> [lb])
    -> ((EquivalenceClass lb, EquivalenceClass lb)
        -> EquivalenceClass lb)
    -> (EquivalenceClass lb, EquivalenceClass lb)
    -> [lb]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (EquivalenceClass lb, EquivalenceClass lb) -> EquivalenceClass lb
    forall a b. (a, b) -> a
    fst) [(EquivalenceClass lb, EquivalenceClass lb)]
    ecpairs
            LabelMap Word32
    gen2 Map lb LabelIndex
    lm2 =
                ArcSet lb -> LabelMap lb -> [lb] -> LabelMap lb
    forall lb.
    Label lb =>
    ArcSet lb -> LabelMap lb -> [lb] -> LabelMap lb
    remapLabels ArcSet lb
    gs2 LabelMap lb
    lmap ([lb] -> LabelMap lb) -> [lb] -> LabelMap lb
    forall a b. (a -> b) -> a -> b
    $ ([lb] -> [lb] -> [lb]) -> [[lb]] -> [lb]
    forall a. (a -> a -> a) -> [a] -> a
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldl1 [lb] -> [lb] -> [lb]
    forall a. [a] -> [a] -> [a]
    (++) ([[lb]] -> [lb]) -> [[lb]] -> [lb]
    forall a b. (a -> b) -> a -> b
    $ ((EquivalenceClass lb, EquivalenceClass lb) -> [lb])
    -> [(EquivalenceClass lb, EquivalenceClass lb)] -> [[lb]]
    forall a b. (a -> b) -> [a] -> [b]
    map (EquivalenceClass lb -> [lb]
    forall lb. EquivalenceClass lb -> [lb]
    ecLabels (EquivalenceClass lb -> [lb])
    -> ((EquivalenceClass lb, EquivalenceClass lb)
        -> EquivalenceClass lb)
    -> (EquivalenceClass lb, EquivalenceClass lb)
    -> [lb]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (EquivalenceClass lb, EquivalenceClass lb) -> EquivalenceClass lb
    forall a b. (a, b) -> b
    snd) [(EquivalenceClass lb, EquivalenceClass lb)]
    ecpairs

            lm' :: Map lb LabelIndex
    lm' = Map lb LabelIndex -> Map lb LabelIndex -> Map lb LabelIndex
    forall a b. Ord a => Map a b -> Map a b -> Map a b
    classifyCombine Map lb LabelIndex
    lm (Map lb LabelIndex -> Map lb LabelIndex)
    -> Map lb LabelIndex -> Map lb LabelIndex
    forall a b. (a -> b) -> a -> b
    $ Map lb LabelIndex -> Map lb LabelIndex -> Map lb LabelIndex
    forall a b. Ord a => Map a b -> Map a b -> Map a b
    M.union Map lb LabelIndex
    lm1 Map lb LabelIndex
    lm2

            tmap :: (t -> b) -> (t, t) -> (b, b)
    tmap t -> b
    f (t
    a,t
    b) = (t -> b
    f t
    a, t -> b
    f t
    b)

            -- ecGroups :: [([EquivalenceClass lb],[EquivalenceClass lb])]
            ecGroups :: [([EquivalenceClass lb], [EquivalenceClass lb])]
    ecGroups  = ((EquivalenceClass lb, EquivalenceClass lb)
     -> ([EquivalenceClass lb], [EquivalenceClass lb]))
    -> [(EquivalenceClass lb, EquivalenceClass lb)]
    -> [([EquivalenceClass lb], [EquivalenceClass lb])]
    forall a b. (a -> b) -> [a] -> [b]
    map ((EquivalenceClass lb -> [EquivalenceClass lb])
    -> (EquivalenceClass lb, EquivalenceClass lb)
    -> ([EquivalenceClass lb], [EquivalenceClass lb])
    forall {t} {b}. (t -> b) -> (t, t) -> (b, b)
    tmap EquivalenceClass lb -> [EquivalenceClass lb]
    forall {a}. (a, [lb]) -> [EquivalenceClass lb]
    remapEc) [(EquivalenceClass lb, EquivalenceClass lb)]
    ecpairs
            ecpairs' :: [(EquivalenceClass lb, EquivalenceClass lb)]
    ecpairs'  = (([EquivalenceClass lb], [EquivalenceClass lb])
     -> [(EquivalenceClass lb, EquivalenceClass lb)])
    -> [([EquivalenceClass lb], [EquivalenceClass lb])]
    -> [(EquivalenceClass lb, EquivalenceClass lb)]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (([EquivalenceClass lb]
     -> [EquivalenceClass lb]
     -> [(EquivalenceClass lb, EquivalenceClass lb)])
    -> ([EquivalenceClass lb], [EquivalenceClass lb])
    -> [(EquivalenceClass lb, EquivalenceClass lb)]
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry [EquivalenceClass lb]
    -> [EquivalenceClass lb]
    -> [(EquivalenceClass lb, EquivalenceClass lb)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip) [([EquivalenceClass lb], [EquivalenceClass lb])]
    ecGroups
            newPart :: Bool
    newPart   = ((Int, Int) -> Bool) -> [(Int, Int)] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Int, Int) -> Bool
    forall {a} {a}. (Ord a, Ord a, Num a, Num a) => (a, a) -> Bool
    pairG1 [(Int, Int)]
    lenGroups
            matchPart :: Bool
    matchPart = ((Int, Int) -> Bool) -> [(Int, Int)] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (Int, Int) -> Bool
    pairEq [(Int, Int)]
    lenGroups
            lenGroups :: [(Int, Int)]
    lenGroups = (([EquivalenceClass lb], [EquivalenceClass lb]) -> (Int, Int))
    -> [([EquivalenceClass lb], [EquivalenceClass lb])] -> [(Int, Int)]
    forall a b. (a -> b) -> [a] -> [b]
    map (([EquivalenceClass lb] -> Int)
    -> ([EquivalenceClass lb], [EquivalenceClass lb]) -> (Int, Int)
    forall {t} {b}. (t -> b) -> (t, t) -> (b, b)
    tmap [EquivalenceClass lb] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length) [([EquivalenceClass lb], [EquivalenceClass lb])]
    ecGroups
            pairEq :: (Int, Int) -> Bool
    pairEq = (Int -> Int -> Bool) -> (Int, Int) -> Bool
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    (==)
            pairG1 :: (a, a) -> Bool
    pairG1 (a
    p1,a
    p2) = a
    p1 a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    > a
    1 Bool -> Bool -> Bool
    || a
    p2 a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    > a
    1
            remapEc :: (a, [lb]) -> [EquivalenceClass lb]
    remapEc = [(LabelIndex, lb)] -> [EquivalenceClass lb]
    forall a b. Ord a => [(a, b)] -> [(a, [b])]
    pairGroup ([(LabelIndex, lb)] -> [EquivalenceClass lb])
    -> ((a, [lb]) -> [(LabelIndex, lb)])
    -> (a, [lb])
    -> [EquivalenceClass lb]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((a, lb) -> (LabelIndex, lb)) -> [(a, lb)] -> [(LabelIndex, lb)]
    forall a b. (a -> b) -> [a] -> [b]
    map (Map lb LabelIndex -> (a, lb) -> (LabelIndex, lb)
    forall {b} {a}.
    Ord b =>
    Map b LabelIndex -> (a, b) -> (LabelIndex, b)
    newIndex Map lb LabelIndex
    lm') ([(a, lb)] -> [(LabelIndex, lb)])
    -> ((a, [lb]) -> [(a, lb)]) -> (a, [lb]) -> [(LabelIndex, lb)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a, [lb]) -> [(a, lb)]
    forall a b. (a, [b]) -> [(a, b)]
    pairUngroup
            newIndex :: Map b LabelIndex -> (a, b) -> (LabelIndex, b)
    newIndex Map b LabelIndex
    x (a
    _,b
    lab) = (LabelIndex -> b -> Map b LabelIndex -> LabelIndex
    forall k a. Ord k => a -> k -> Map k a -> a
    M.findWithDefault LabelIndex
    nullLabelVal b
    lab Map b LabelIndex
    x,b
    lab)

    -- Replace the values in lm1 with those from lm2, but do not copy over new
    -- keys from lm2
    classifyCombine :: (Ord a) => M.Map a b -> M.Map a b -> M.Map a b
    classifyCombine :: forall a b. Ord a => Map a b -> Map a b -> Map a b
    classifyCombine = (a -> b -> b -> Maybe b)
    -> (Map a b -> Map a b)
    -> (Map a b -> Map a b)
    -> Map a b
    -> Map a b
    -> Map a b
    forall k a b c.
    Ord k =>
    (k -> a -> b -> Maybe c)
    -> (Map k a -> Map k c)
    -> (Map k b -> Map k c)
    -> Map k a
    -> Map k b
    -> Map k c
    M.mergeWithKey (\a
    _ b
    _ b
    v -> b -> Maybe b
    forall a. a -> Maybe a
    Just b
    v) Map a b -> Map a b
    forall a. a -> a
    id (Map a b -> Map a b -> Map a b
    forall a b. a -> b -> a
    const Map a b
    forall k a. Map k a
    M.empty)

    -- | Calculate a new index value for a supplied set of labels based on the
    --  supplied label map and adjacency calculations in the supplied graph
    --
    remapLabels ::
      (Label lb)
      => ArcSet lb -- ^ arcs used for adjacency calculations when remapping
      -> LabelMap lb -- ^ the current label index values
      -> [lb] -- ^ the graph labels for which new mappings are to be created
      -> LabelMap lb
      -- ^ the updated label map containing recalculated label index values
      -- for the given graph labels. The label map generation number is
      -- incremented by 1.
    remapLabels :: forall lb.
    Label lb =>
    ArcSet lb -> LabelMap lb -> [lb] -> LabelMap lb
    remapLabels ArcSet lb
    gs lmap :: LabelMap lb
    lmap@(LabelMap Word32
    gen Map lb LabelIndex
    _) [lb]
    ls =
        Word32 -> Map lb LabelIndex -> LabelMap lb
    forall lb lv.
    (Label lb, Eq lv, Show lv) =>
    Word32 -> Map lb lv -> GenLabelMap lb lv
    LabelMap Word32
    gen' (Map lb LabelIndex -> LabelMap lb)
    -> Map lb LabelIndex -> LabelMap lb
    forall a b. (a -> b) -> a -> b
    $ [(lb, LabelIndex)] -> Map lb LabelIndex
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList [(lb, LabelIndex)]
    newEntries
        where
            gen' :: Word32
    gen'                = Word32
    gen Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    + Word32
    1
            newEntries :: [(lb, LabelIndex)]
    newEntries          = [ (lb
    l, (Word32
    gen', Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (lb -> Int
    newIndex lb
    l))) | lb
    l <- [lb]
    ls ]
            -- TODO: should review this given the changes to the hash code
            --       since it was re-written
            newIndex :: lb -> Int
    newIndex lb
    l
                | lb -> Bool
    forall lb. Label lb => lb -> Bool
    labelIsVar lb
    l  = lb -> Int
    mapAdjacent lb
    l    -- adjacency classifies variable labels
                | Bool
    otherwise     = Word32 -> lb -> Int
    forall lb. Label lb => Word32 -> lb -> Int
    hashVal Word32
    gen lb
    l    -- otherwise rehash (to disentangle collisions)  TODO: BRANCH IS UNTESTED

            -- mapAdjacent used to use `rem` hashModulus
            mapAdjacent :: lb -> Int
    mapAdjacent lb
    l       = Int
    hashModulus Int -> Int -> Int
    forall a. Hashable a => Int -> a -> Int
    `hashWithSalt` [Int] -> Int
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum (lb -> [Int]
    sigsOver lb
    l)

            gls :: [Arc lb]
    gls = ArcSet lb -> [Arc lb]
    forall a. Set a -> [a]
    S.toList ArcSet lb
    gs

            sigsOver :: lb -> [Int]
    sigsOver lb
    l          = (Arc lb -> Bool) -> [Arc lb] -> [Int] -> [Int]
    forall a b. (a -> Bool) -> [a] -> [b] -> [b]
    select (lb -> Arc lb -> Bool
    forall lb. Eq lb => lb -> Arc lb -> Bool
    hasLabel lb
    l) [Arc lb]
    gls (LabelMap lb -> [Arc lb] -> [Int]
    forall lb. Label lb => LabelMap lb -> [Arc lb] -> [Int]
    arcSignatures LabelMap lb
    lmap [Arc lb]
    gls)

    -- |Select is like filter, except that it tests one list to select
    --  elements from a second list.
    select :: ( a -> Bool ) -> [a] -> [b] -> [b]
    select :: forall a b. (a -> Bool) -> [a] -> [b] -> [b]
    select a -> Bool
    _ [] []           = []
    select a -> Bool
    f (a
    e1:[a]
    l1) (b
    e2:[b]
    l2)
        | a -> Bool
    f a
    e1      = b
    e2 b -> [b] -> [b]
    forall a. a -> [a] -> [a]
    : (a -> Bool) -> [a] -> [b] -> [b]
    forall a b. (a -> Bool) -> [a] -> [b] -> [b]
    select a -> Bool
    f [a]
    l1 [b]
    l2
        | Bool
    otherwise = (a -> Bool) -> [a] -> [b] -> [b]
    forall a b. (a -> Bool) -> [a] -> [b] -> [b]
    select a -> Bool
    f [a]
    l1 [b]
    l2
    select a -> Bool
    _ [a]
    _ [b]
    _    = String -> [b]
    forall a. HasCallStack => String -> a
    error String
    "select supplied with different length lists"

    -- | Return the set of distinct labels used in the graph.

    graphLabels :: (Label lb) => ArcSet lb -> S.Set lb
    graphLabels :: forall lb. Label lb => ArcSet lb -> Set lb
    graphLabels = (Arc lb -> [lb]) -> Set (Arc lb) -> Set lb
    forall b a. Ord b => (a -> [b]) -> Set a -> Set b
    getComponents Arc lb -> [lb]
    forall lb. Arc lb -> [lb]
    arcLabels

    -- TODO: worry about overflow?

    -- TODO: should probably return a Set of (Int, Arc lb) or something,
    -- as may be useful for the calling code

    -- | Calculate a signature value for each arc that can be used in
    --   constructing an adjacency based value for a node.  The adjacancy
    --   value for a label is obtained by summing the signatures of all
    --   statements containing that label.
    --
    arcSignatures ::
      (Label lb)
      => LabelMap lb -- ^ the current label index values
      -> [Arc lb] -- ^ calculate signatures for these arcs
      -> [Int] -- ^ the signatures of the arcs
    arcSignatures :: forall lb. Label lb => LabelMap lb -> [Arc lb] -> [Int]
    arcSignatures LabelMap lb
    lmap =
        (Arc lb -> Int) -> [Arc lb] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map ((lb, lb, lb) -> Int
    sigCalc ((lb, lb, lb) -> Int) -> (Arc lb -> (lb, lb, lb)) -> Arc lb -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Arc lb -> (lb, lb, lb)
    forall lb. Arc lb -> (lb, lb, lb)
    arcToTriple)
        where
            sigCalc :: (lb, lb, lb) -> Int
    sigCalc (lb
    s,lb
    p,lb
    o)  =
                Int
    hashModulus Int -> Word32 -> Int
    forall a. Hashable a => Int -> a -> Int
    `hashWithSalt`
                  ( lb -> Word32
    labelVal2 lb
    s Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    +
                    lb -> Word32
    labelVal2 lb
    p Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    * Word32
    3 Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    +
                    lb -> Word32
    labelVal2 lb
    o Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    * Word32
    5 )

            labelVal :: lb -> LabelIndex
    labelVal         = LabelMap lb -> lb -> LabelIndex
    forall lb. Label lb => LabelMap lb -> lb -> LabelIndex
    mapLabelIndex LabelMap lb
    lmap
            labelVal2 :: lb -> Word32
    labelVal2        = (Word32 -> Word32 -> Word32) -> LabelIndex -> Word32
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    (*) (LabelIndex -> Word32) -> (lb -> LabelIndex) -> lb -> Word32
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . lb -> LabelIndex
    labelVal

    -- | Return a new graph that is supplied graph with every node/arc
    --  mapped to a new value according to the supplied function.
    --
    --  Used for testing for graph equivalence under a supplied
    --  label mapping;  e.g.
    --
    --  >  if ( graphMap nodeMap gs1 ) == ( graphMap nodeMap gs2 ) then (same)
    --
    graphMap ::
        (Label lb)
        => LabelMap lb
        -> ArcSet lb
        -> ArcSet LabelIndex
    graphMap :: forall lb.
    Label lb =>
    LabelMap lb -> ArcSet lb -> ArcSet LabelIndex
    graphMap = (Arc lb -> Arc LabelIndex) -> Set (Arc lb) -> ArcSet LabelIndex
    forall b a. Ord b => (a -> b) -> Set a -> Set b
    S.map ((Arc lb -> Arc LabelIndex) -> Set (Arc lb) -> ArcSet LabelIndex)
    -> (LabelMap lb -> Arc lb -> Arc LabelIndex)
    -> LabelMap lb
    -> Set (Arc lb)
    -> ArcSet LabelIndex
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (lb -> LabelIndex) -> Arc lb -> Arc LabelIndex
    forall a b. (a -> b) -> Arc a -> Arc b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((lb -> LabelIndex) -> Arc lb -> Arc LabelIndex)
    -> (LabelMap lb -> lb -> LabelIndex)
    -> LabelMap lb
    -> Arc lb
    -> Arc LabelIndex
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LabelMap lb -> lb -> LabelIndex
    forall lb. Label lb => LabelMap lb -> lb -> LabelIndex
    mapLabelIndex

    -- | Compare a pair of graphs for equivalence under a given mapping
    --   function.
    --
    --  This is used to perform the ultimate test that two graphs are
    --  indeed equivalent:  guesswork in `graphMatch2` means that it is
    --  occasionally possible to construct a node mapping that generates
    --  the required singleton equivalence classes, but does not fully
    --  reflect the topology of the graphs.

    graphMapEq ::
        (Label lb)
        => LabelMap lb
        -> ArcSet lb
        -> ArcSet lb
        -> Bool
    graphMapEq :: forall lb.
    Label lb =>
    LabelMap lb -> ArcSet lb -> ArcSet lb -> Bool
    graphMapEq LabelMap lb
    lmap = ArcSet LabelIndex -> ArcSet LabelIndex -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) (ArcSet LabelIndex -> ArcSet LabelIndex -> Bool)
    -> (ArcSet lb -> ArcSet LabelIndex)
    -> ArcSet lb
    -> ArcSet lb
    -> Bool
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` LabelMap lb -> ArcSet lb -> ArcSet LabelIndex
    forall lb.
    Label lb =>
    LabelMap lb -> ArcSet lb -> ArcSet LabelIndex
    graphMap LabelMap lb
    lmap

    --------------------------------------------------------------------------------
    --
    --  Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin,
    --    2011, 2012, 2016, 2018, 2020, 2022, 2024 Douglas Burke
    --  All rights reserved.
    --
    --  This file is part of Swish.
    --
    --  Swish is free software; you can redistribute it and/or modify
    --  it under the terms of the GNU General Public License as published by
    --  the Free Software Foundation; either version 2 of the License, or
    --  (at your option) any later version.
    --
    --  Swish is distributed in the hope that it will be useful,
    --  but WITHOUT ANY WARRANTY; without even the implied warranty of
    --  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    --  GNU General Public License for more details.
    --
    --  You should have received a copy of the GNU General Public License
    --  along with Swish; if not, write to:
    --    The Free Software Foundation, Inc.,
    --    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
    --
    --------------------------------------------------------------------------------