    {-# 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 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 Swish.GraphClass (Arc(..), ArcSet, Label(..))
    import Swish.GraphClass (getComponents, arcLabels, hasLabel, arcToTriple)

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

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

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

    --------------------------
    --  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 = (0, 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 k :: lb
    k v :: lv
    v) = lb -> String
    forall a. Show a => a -> String
    show lb
    k String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ":" 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 k1 :: lb
    k1 v1 :: lv
    v1) == :: GenLabelEntry lb lv -> GenLabelEntry lb lv -> Bool
    == (LabelEntry k2 :: lb
    k2 v2 :: 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 lb1 :: lb
    lb1 lv1 :: lv
    lv1) compare :: GenLabelEntry lb lv -> GenLabelEntry lb lv -> Ordering
    `compare` (LabelEntry lb2 :: lb
    lb2 lv2 :: 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 gen1 :: Word32
    gen1 lmap1 :: Map lb LabelIndex
    lmap1 == :: LabelMap lb -> LabelMap lb -> Bool
    == LabelMap gen2 :: Word32
    gen2 lmap2 :: 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 :: LabelMap lb
    emptyMap = Word32 -> Map lb LabelIndex -> LabelMap lb
    forall lb lv. Word32 -> Map lb lv -> GenLabelMap lb lv
    LabelMap 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 :: EquivalenceClass lb -> [lb]
    ecLabels = EquivalenceClass 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 :: EquivalenceClass lb -> lb -> EquivalenceClass lb
    ecRemoveLabel xs :: EquivalenceClass lb
    xs l :: lb
    l = ([lb] -> [lb]) -> EquivalenceClass lb -> EquivalenceClass lb
    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 :: (a, [b]) -> [(a, b)]
    pairUngroup (a :: a
    a,bs :: [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 :: [(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 :: [(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 (as :: [a]
    as, bs :: b
    bs) = ([a] -> a
    forall a. [a] -> a
    head [a]
    as, 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 :: Int -> lb -> ScopedLabel lb
    makeScopedLabel = Int -> lb -> ScopedLabel lb
    forall 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 :: Int -> Arc lb -> Arc (ScopedLabel lb)
    makeScopedArc scope :: Int
    scope = (lb -> ScopedLabel lb) -> Arc lb -> Arc (ScopedLabel lb)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Int -> lb -> ScopedLabel lb
    forall lb. Int -> lb -> ScopedLabel lb
    ScopedLabel Int
    scope)

    instance (Label lb) => Label (ScopedLabel lb) where
        getLocal :: ScopedLabel lb -> String
    getLocal  lab :: ScopedLabel lb
    lab    = ShowS
    forall a. HasCallStack => String -> a
    error ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ "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 locnam :: String
    locnam = String -> ScopedLabel lb
    forall a. HasCallStack => String -> a
    error (String -> ScopedLabel lb) -> String -> ScopedLabel lb
    forall a b. (a -> b) -> a -> b
    $ "makeLabel for ScopedLabel: "String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    locnam
        labelIsVar :: ScopedLabel lb -> Bool
    labelIsVar (ScopedLabel _ lab :: lb
    lab)   = lb -> Bool
    forall lb. Label lb => lb -> Bool
    labelIsVar lb
    lab
        labelHash :: Int -> ScopedLabel lb -> Int
    labelHash seed :: Int
    seed (ScopedLabel scope :: Int
    scope lab :: 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 s1 :: Int
    s1 l1 :: lb
    l1) == :: ScopedLabel lb -> ScopedLabel lb -> Bool
    == (ScopedLabel s2 :: Int
    s2 l2 :: 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 s1 :: Int
    s1 l1 :: lb
    l1) = Int -> String
    forall a. Show a => a -> String
    show Int
    s1 String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ":" 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 s1 :: Int
    s1 l1 :: lb
    l1) (ScopedLabel s2 :: Int
    s2 l2 :: lb
    l2) =
            case Int -> Int -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare Int
    s1 Int
    s2 of
                LT -> Ordering
    LT
                EQ -> lb -> lb -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare lb
    l1 lb
    l2
                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 :: (lb -> lb -> Bool)
    -> ArcSet lb -> ArcSet lb -> (Bool, LabelMap (ScopedLabel lb))
    graphMatch matchable :: lb -> lb -> Bool
    matchable gs1 :: ArcSet lb
    gs1 gs2 :: 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 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 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 _ l1 :: lb
    l1) (ScopedLabel _ l2 :: 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 (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 (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 :: Bool
    -> (lb -> lb -> Bool)
    -> ArcSet lb
    -> ArcSet lb
    -> LabelMap lb
    -> [(EquivalenceClass lb, EquivalenceClass lb)]
    -> (Bool, LabelMap lb)
    graphMatch1 guessed :: Bool
    guessed matchable :: lb -> lb -> Bool
    matchable gs1 :: ArcSet lb
    gs1 gs2 :: ArcSet lb
    gs2 lmap :: LabelMap lb
    lmap ecpairs :: [(EquivalenceClass lb, EquivalenceClass lb)]
    ecpairs =
        let
            (secs :: [(EquivalenceClass lb, EquivalenceClass lb)]
    secs,mecs :: [(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 ( (_,[_])  , (_,[_])  ) = Bool
    True
            uniqueEc (  _       ,  _       ) = Bool
    False

            doMatch :: ((a, [lb]), (a, [lb])) -> Bool
    doMatch  ( (_,[l1 :: lb
    l1]) , (_,[l2 :: 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  x :: ((a, [lb]), (a, [lb]))
    x = String -> Bool
    forall a. HasCallStack => String -> a
    error (String -> Bool) -> String -> Bool
    forall a b. (a -> b) -> a -> b
    $ "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 ( (_,ls1 :: t a
    ls1)  , (_,ls2 :: t a
    ls2)  ) = 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 (t :: * -> *) a. Foldable t => t a -> Int
    length t a
    ls2
            eSize :: ((a, t a), b) -> Int
    eSize    ( (_,ls1 :: t a
    ls1)  , _        ) = 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
            (lmap' :: LabelMap lb
    lmap',mecs' :: [(EquivalenceClass lb, EquivalenceClass lb)]
    mecs',newEc :: Bool
    newEc,matchEc :: 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 (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 :: (lb -> lb -> Bool)
    -> ArcSet lb
    -> ArcSet lb
    -> LabelMap lb
    -> [(EquivalenceClass lb, EquivalenceClass lb)]
    -> (Bool, LabelMap lb)
    graphMatch2 _         _   _   _    [] = String -> (Bool, LabelMap lb)
    forall a. HasCallStack => String -> a
    error "graphMatch2 sent an empty list" -- To keep -Wall happy
    graphMatch2 matchable :: lb -> lb -> Bool
    matchable gs1 :: ArcSet lb
    gs1 gs2 :: ArcSet lb
    gs2 lmap :: LabelMap lb
    lmap ((ec1 :: EquivalenceClass lb
    ec1@(ev1 :: LabelIndex
    ev1,ls1 :: [lb]
    ls1),ec2 :: EquivalenceClass lb
    ec2@(ev2 :: LabelIndex
    ev2,ls2 :: [lb]
    ls2)):ecpairs :: [(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 ((l1 :: lb
    l1,l2 :: lb
    l2):lps :: [(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 (False,_)   _  _  = Bool
    False
                    isEquiv (True,lm :: LabelMap lb
    lm) x1 :: lb
    x1 x2 :: 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
    ev1LabelIndex -> 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 = 16000001

    -- | Returns a string representation  of a LabelMap value
    --
    showLabelMap :: (Label lb) => LabelMap lb -> String
    showLabelMap :: LabelMap lb -> String
    showLabelMap (LabelMap gn :: Word32
    gn lmap :: Map lb LabelIndex
    lmap) =
        "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]
    ++", map="String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
        (String -> ShowS) -> String -> [String] -> String
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' String -> ShowS
    forall a. [a] -> [a] -> [a]
    (++) "" (((lb, LabelIndex) -> String) -> [(lb, LabelIndex)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (("\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 :: LabelMap lb -> lb -> LabelIndex
    mapLabelIndex (LabelMap _ lxms :: Map lb LabelIndex
    lxms) lb :: 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 :: (lb -> lb -> Bool) -> LabelMap lb -> lb -> lb -> Bool
    labelMatch matchable :: lb -> lb -> Bool
    matchable lmap :: LabelMap lb
    lmap l1 :: lb
    l1 l2 :: 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 :: LabelMap lb -> [(lb, Word32)] -> LabelMap lb
    newLabelMap lmap :: LabelMap lb
    lmap []       = LabelMap lb -> LabelMap lb
    forall lb. Label lb => LabelMap lb -> LabelMap lb
    newGenerationMap LabelMap lb
    lmap
    newLabelMap lmap :: LabelMap lb
    lmap (lv :: (lb, Word32)
    lv:lvs :: [(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 :: LabelMap lb -> (lb, Word32) -> LabelMap lb
    setLabelHash  (LabelMap g :: Word32
    g lmap :: Map lb LabelIndex
    lmap) (lb :: lb
    lb,lh :: Word32
    lh) =
        Word32 -> Map lb LabelIndex -> LabelMap lb
    forall lb lv. Word32 -> Map lb lv -> GenLabelMap lb lv
    LabelMap Word32
    g (Map lb LabelIndex -> LabelMap lb)
    -> Map lb LabelIndex -> LabelMap lb
    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 :: LabelMap lb -> LabelMap lb
    newGenerationMap (LabelMap g :: Word32
    g lvs :: Map lb LabelIndex
    lvs) = Word32 -> Map lb LabelIndex -> LabelMap lb
    forall lb lv. Word32 -> Map lb lv -> GenLabelMap lb lv
    LabelMap (Word32
    gWord32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    +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 :: Set lb -> LabelMap lb -> LabelMap lb
    assignLabelMap ns :: Set lb
    ns lmap :: 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 :: lb -> LabelMap lb -> LabelMap lb
    assignLabelMap1 lab :: lb
    lab (LabelMap g :: Word32
    g lvs :: Map lb LabelIndex
    lvs) =
        Word32 -> Map lb LabelIndex -> LabelMap lb
    forall lb lv. Word32 -> Map lb lv -> GenLabelMap lb lv
    LabelMap Word32
    g (Map lb LabelIndex -> LabelMap lb)
    -> Map lb LabelIndex -> LabelMap lb
    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 :: 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 0

    hashVal :: (Label lb) => Word32 -> lb -> Int
    hashVal :: Word32 -> lb -> Int
    hashVal seed :: Word32
    seed lab :: lb
    lab =
      if lb -> Bool
    forall lb. Label lb => lb -> Bool
    labelIsVar lb
    lab then 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 :: LabelMap lb -> Set lb -> [EquivalenceClass lb]
    equivalenceClasses lmap :: LabelMap lb
    lmap ls :: Set lb
    ls =
        [(LabelIndex, lb)] -> [EquivalenceClass lb]
    forall a b. Ord a => [(a, b)] -> [(a, [b])]
    pairGroup ([(LabelIndex, lb)] -> [EquivalenceClass lb])
    -> [(LabelIndex, lb)] -> [EquivalenceClass 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 l :: 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 :: ArcSet lb
    -> ArcSet lb
    -> LabelMap lb
    -> [(EquivalenceClass lb, EquivalenceClass lb)]
    -> (LabelMap lb, [(EquivalenceClass lb, EquivalenceClass lb)],
        Bool, Bool)
    reclassify gs1 :: ArcSet lb
    gs1 gs2 :: ArcSet lb
    gs2 lmap :: LabelMap lb
    lmap@(LabelMap _ lm :: Map lb LabelIndex
    lm) ecpairs :: [(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
    gen1Word32 -> Word32 -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Word32
    gen2) -- "Label map generation mismatch"
          (Word32 -> Map lb LabelIndex -> LabelMap lb
    forall lb 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 gen1 :: Word32
    gen1 lm1 :: 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 (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 gen2 :: Word32
    gen2 lm2 :: 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 (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 f :: t -> b
    f (a :: t
    a,b :: 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 (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 (p1 :: a
    p1,p2 :: a
    p2) = a
    p1 a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    > 1 Bool -> Bool -> Bool
    || a
    p2 a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    > 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 x :: Map b LabelIndex
    x (_,lab :: 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 :: 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 (\_ _ v :: 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 :: ArcSet lb -> LabelMap lb -> [lb] -> LabelMap lb
    remapLabels gs :: ArcSet lb
    gs lmap :: LabelMap lb
    lmap@(LabelMap gen :: Word32
    gen _) ls :: [lb]
    ls =
        Word32 -> Map lb LabelIndex -> LabelMap lb
    forall lb 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
    genWord32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    +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 l :: lb
    l
                | lb -> Bool
    forall lb. Label lb => lb -> Bool
    labelIsVar lb
    l  = lb -> Int
    mapAdjacent lb
    l                 -- adjacency classifies variable labels
                | Bool
    otherwise     = Int -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Word32 -> lb -> Int
    forall lb. Label lb => Word32 -> lb -> Int
    hashVal Word32
    gen lb
    l  -- otherwise rehash (to disentangle collisions)

            -- mapAdjacent used to use `rem` hashModulus
            mapAdjacent :: lb -> Int
    mapAdjacent l :: lb
    l       = Int
    hashModulus Int -> Int -> Int
    forall a. Hashable a => Int -> a -> Int
    `hashWithSalt` [Int] -> Int
    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 l :: 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 :: (a -> Bool) -> [a] -> [b] -> [b]
    select _ [] []           = []
    select f :: a -> Bool
    f (e1 :: a
    e1:l1 :: [a]
    l1) (e2 :: b
    e2:l2 :: [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 _ _ _    = String -> [b]
    forall a. HasCallStack => String -> a
    error "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 :: ArcSet lb -> Set lb
    graphLabels = (Arc lb -> [lb]) -> ArcSet 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 :: LabelMap lb -> [Arc lb] -> [Int]
    arcSignatures lmap :: 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 (s :: lb
    s,p :: lb
    p,o :: 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
    * 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
    * 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 :: LabelMap lb -> ArcSet lb -> ArcSet LabelIndex
    graphMap = (Arc lb -> Arc LabelIndex) -> ArcSet lb -> ArcSet LabelIndex
    forall b a. Ord b => (a -> b) -> Set a -> Set b
    S.map ((Arc lb -> Arc LabelIndex) -> ArcSet lb -> ArcSet LabelIndex)
    -> (LabelMap lb -> Arc lb -> Arc LabelIndex)
    -> LabelMap lb
    -> ArcSet lb
    -> ArcSet LabelIndex
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (lb -> LabelIndex) -> Arc lb -> Arc LabelIndex
    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 :: LabelMap lb -> ArcSet lb -> ArcSet lb -> Bool
    graphMapEq lmap :: 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 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
    --
    --------------------------------------------------------------------------------