module Unison.Runtime.ANF.Rehash where

import Crypto.Hash
import Data.Bifunctor (bimap, first, second)
import Data.ByteArray (convert)
import Data.ByteString (cons)
import Data.ByteString.Lazy (toChunks)
import Data.Graph as Gr
import Data.List (foldl', nub, sortBy)
import Data.Map.Strict qualified as Map
import Data.Ord (comparing)
import Data.Set qualified as Set
import Data.Text (Text)
import Unison.Hash (fromByteString)
import Unison.Reference as Reference
import Unison.Referent as Referent
import Unison.Runtime.ANF as ANF
import Unison.Runtime.ANF.Serialize as ANF
import Unison.Var (Var)

checkGroupHashes ::
  (Var v) =>
  [(Referent, SuperGroup v)] ->
  Either (Text, [Referent]) (Either [Referent] [Referent])
checkGroupHashes :: forall v.
Var v =>
[(Referent, SuperGroup v)]
-> Either (Text, [Referent]) (Either [Referent] [Referent])
checkGroupHashes [(Referent, SuperGroup v)]
rgs = case [(Referent, SuperGroup v)] -> Either (Text, [Referent]) [Reference]
forall v.
Var v =>
[(Referent, SuperGroup v)] -> Either (Text, [Referent]) [Reference]
checkMissing [(Referent, SuperGroup v)]
rgs of
  Left (Text, [Referent])
err -> (Text, [Referent])
-> Either (Text, [Referent]) (Either [Referent] [Referent])
forall a b. a -> Either a b
Left (Text, [Referent])
err
  Right [] ->
    case Map Reference (SuperGroup v)
-> Either
     (Text, [Referent])
     (Map Reference Reference, Map Reference (SuperGroup v))
forall v.
Var v =>
Map Reference (SuperGroup v)
-> Either
     (Text, [Referent])
     (Map Reference Reference, Map Reference (SuperGroup v))
rehashGroups (Map Reference (SuperGroup v)
 -> Either
      (Text, [Referent])
      (Map Reference Reference, Map Reference (SuperGroup v)))
-> ([(Reference, SuperGroup v)] -> Map Reference (SuperGroup v))
-> [(Reference, SuperGroup v)]
-> Either
     (Text, [Referent])
     (Map Reference Reference, Map Reference (SuperGroup v))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Reference, SuperGroup v)] -> Map Reference (SuperGroup v)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Reference, SuperGroup v)]
 -> Either
      (Text, [Referent])
      (Map Reference Reference, Map Reference (SuperGroup v)))
-> [(Reference, SuperGroup v)]
-> Either
     (Text, [Referent])
     (Map Reference Reference, Map Reference (SuperGroup v))
forall a b. (a -> b) -> a -> b
$ (Referent -> Reference)
-> (Referent, SuperGroup v) -> (Reference, SuperGroup v)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Referent -> Reference
toReference ((Referent, SuperGroup v) -> (Reference, SuperGroup v))
-> [(Referent, SuperGroup v)] -> [(Reference, SuperGroup v)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Referent, SuperGroup v)]
rgs of
      Left (Text, [Referent])
err -> (Text, [Referent])
-> Either (Text, [Referent]) (Either [Referent] [Referent])
forall a b. a -> Either a b
Left (Text, [Referent])
err
      Right (Map Reference Reference
rrs, Map Reference (SuperGroup v)
_) ->
        Either [Referent] [Referent]
-> Either (Text, [Referent]) (Either [Referent] [Referent])
forall a b. b -> Either a b
Right (Either [Referent] [Referent]
 -> Either (Text, [Referent]) (Either [Referent] [Referent]))
-> ([(Reference, Reference)] -> Either [Referent] [Referent])
-> [(Reference, Reference)]
-> Either (Text, [Referent]) (Either [Referent] [Referent])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Referent] -> Either [Referent] [Referent]
forall a b. b -> Either a b
Right ([Referent] -> Either [Referent] [Referent])
-> ([(Reference, Reference)] -> [Referent])
-> [(Reference, Reference)]
-> Either [Referent] [Referent]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Reference, Reference) -> Referent)
-> [(Reference, Reference)] -> [Referent]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Reference -> Referent
Ref (Reference -> Referent)
-> ((Reference, Reference) -> Reference)
-> (Reference, Reference)
-> Referent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Reference, Reference) -> Reference
forall a b. (a, b) -> a
fst) ([(Reference, Reference)] -> [Referent])
-> ([(Reference, Reference)] -> [(Reference, Reference)])
-> [(Reference, Reference)]
-> [Referent]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Reference, Reference) -> Bool)
-> [(Reference, Reference)] -> [(Reference, Reference)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Reference -> Reference -> Bool) -> (Reference, Reference) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
(/=)) ([(Reference, Reference)]
 -> Either (Text, [Referent]) (Either [Referent] [Referent]))
-> [(Reference, Reference)]
-> Either (Text, [Referent]) (Either [Referent] [Referent])
forall a b. (a -> b) -> a -> b
$ Map Reference Reference -> [(Reference, Reference)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Reference Reference
rrs
  Right [Reference]
ms -> Either [Referent] [Referent]
-> Either (Text, [Referent]) (Either [Referent] [Referent])
forall a b. b -> Either a b
Right ([Referent] -> Either [Referent] [Referent]
forall a b. a -> Either a b
Left ([Referent] -> Either [Referent] [Referent])
-> [Referent] -> Either [Referent] [Referent]
forall a b. (a -> b) -> a -> b
$ Reference -> Referent
Ref (Reference -> Referent) -> [Reference] -> [Referent]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Reference]
ms)

rehashGroups ::
  (Var v) =>
  Map.Map Reference (SuperGroup v) ->
  Either (Text, [Referent]) (Map.Map Reference Reference, Map.Map Reference (SuperGroup v))
rehashGroups :: forall v.
Var v =>
Map Reference (SuperGroup v)
-> Either
     (Text, [Referent])
     (Map Reference Reference, Map Reference (SuperGroup v))
rehashGroups Map Reference (SuperGroup v)
m
  | [SCC (Reference, SuperGroup v)]
badsccs <- (SCC (Reference, SuperGroup v) -> Bool)
-> [SCC (Reference, SuperGroup v)]
-> [SCC (Reference, SuperGroup v)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (SCC (Reference, SuperGroup v) -> Bool)
-> SCC (Reference, SuperGroup v)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SCC (Reference, SuperGroup v) -> Bool
forall v. SCC (Reference, SuperGroup v) -> Bool
checkSCC) [SCC (Reference, SuperGroup v)]
sccs,
    Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [SCC (Reference, SuperGroup v)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SCC (Reference, SuperGroup v)]
badsccs =
      (Text, [Referent])
-> Either
     (Text, [Referent])
     (Map Reference Reference, Map Reference (SuperGroup v))
forall a b. a -> Either a b
Left (Text
err, ((Reference, SuperGroup v) -> Referent)
-> [(Reference, SuperGroup v)] -> [Referent]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Reference -> Referent
Ref (Reference -> Referent)
-> ((Reference, SuperGroup v) -> Reference)
-> (Reference, SuperGroup v)
-> Referent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Reference, SuperGroup v) -> Reference
forall a b. (a, b) -> a
fst) ([(Reference, SuperGroup v)] -> [Referent])
-> (SCC (Reference, SuperGroup v) -> [(Reference, SuperGroup v)])
-> SCC (Reference, SuperGroup v)
-> [Referent]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SCC (Reference, SuperGroup v) -> [(Reference, SuperGroup v)]
forall vertex. SCC vertex -> [vertex]
flattenSCC (SCC (Reference, SuperGroup v) -> [Referent])
-> [SCC (Reference, SuperGroup v)] -> [Referent]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [SCC (Reference, SuperGroup v)]
badsccs)
  | Bool
otherwise = (Map Reference Reference, Map Reference (SuperGroup v))
-> Either
     (Text, [Referent])
     (Map Reference Reference, Map Reference (SuperGroup v))
forall a b. b -> Either a b
Right ((Map Reference Reference, Map Reference (SuperGroup v))
 -> Either
      (Text, [Referent])
      (Map Reference Reference, Map Reference (SuperGroup v)))
-> (Map Reference Reference, Map Reference (SuperGroup v))
-> Either
     (Text, [Referent])
     (Map Reference Reference, Map Reference (SuperGroup v))
forall a b. (a -> b) -> a -> b
$ ((Map Reference Reference, Map Reference (SuperGroup v))
 -> SCC (Reference, SuperGroup v)
 -> (Map Reference Reference, Map Reference (SuperGroup v)))
-> (Map Reference Reference, Map Reference (SuperGroup v))
-> [SCC (Reference, SuperGroup v)]
-> (Map Reference Reference, Map Reference (SuperGroup v))
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (Map Reference Reference, Map Reference (SuperGroup v))
-> SCC (Reference, SuperGroup v)
-> (Map Reference Reference, Map Reference (SuperGroup v))
forall {v}.
Var v =>
(Map Reference Reference, Map Reference (SuperGroup v))
-> SCC (Reference, SuperGroup v)
-> (Map Reference Reference, Map Reference (SuperGroup v))
step (Map Reference Reference
forall k a. Map k a
Map.empty, Map Reference (SuperGroup v)
forall k a. Map k a
Map.empty) [SCC (Reference, SuperGroup v)]
sccs
  where
    err :: Text
err = Text
"detected mutually recursive bindings with distinct hashes"
    f :: (b, SuperGroup v) -> ((b, SuperGroup v), b, [Reference])
f p :: (b, SuperGroup v)
p@(b
r, SuperGroup v
sg) = ((b, SuperGroup v)
p, b
r, SuperGroup v -> [Reference]
forall v. Var v => SuperGroup v -> [Reference]
groupTermLinks SuperGroup v
sg)

    sccs :: [SCC (Reference, SuperGroup v)]
sccs = [((Reference, SuperGroup v), Reference, [Reference])]
-> [SCC (Reference, SuperGroup v)]
forall key node. Ord key => [(node, key, [key])] -> [SCC node]
stronglyConnComp ([((Reference, SuperGroup v), Reference, [Reference])]
 -> [SCC (Reference, SuperGroup v)])
-> ([(Reference, SuperGroup v)]
    -> [((Reference, SuperGroup v), Reference, [Reference])])
-> [(Reference, SuperGroup v)]
-> [SCC (Reference, SuperGroup v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Reference, SuperGroup v)
 -> ((Reference, SuperGroup v), Reference, [Reference]))
-> [(Reference, SuperGroup v)]
-> [((Reference, SuperGroup v), Reference, [Reference])]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Reference, SuperGroup v)
-> ((Reference, SuperGroup v), Reference, [Reference])
forall {v} {b}.
Var v =>
(b, SuperGroup v) -> ((b, SuperGroup v), b, [Reference])
f ([(Reference, SuperGroup v)] -> [SCC (Reference, SuperGroup v)])
-> [(Reference, SuperGroup v)] -> [SCC (Reference, SuperGroup v)]
forall a b. (a -> b) -> a -> b
$ Map Reference (SuperGroup v) -> [(Reference, SuperGroup v)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Reference (SuperGroup v)
m

    step :: (Map Reference Reference, Map Reference (SuperGroup v))
-> SCC (Reference, SuperGroup v)
-> (Map Reference Reference, Map Reference (SuperGroup v))
step (Map Reference Reference
remap, Map Reference (SuperGroup v)
newSGs) SCC (Reference, SuperGroup v)
scc0 =
      (Map Reference Reference
-> Map Reference Reference -> Map Reference Reference
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map Reference Reference
remap Map Reference Reference
rm, Map Reference (SuperGroup v)
-> Map Reference (SuperGroup v) -> Map Reference (SuperGroup v)
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map Reference (SuperGroup v)
newSGs Map Reference (SuperGroup v)
sgs)
      where
        rp :: Bool -> Reference -> Reference
rp Bool
b Reference
r
          | Bool -> Bool
not Bool
b, Just Reference
r <- Reference -> Map Reference Reference -> Maybe Reference
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Reference
r Map Reference Reference
remap = Reference
r
          | Bool
otherwise = Reference
r
        scc :: SCC (Reference, SuperGroup v)
scc = (SuperGroup v -> SuperGroup v)
-> (Reference, SuperGroup v) -> (Reference, SuperGroup v)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((Bool -> Reference -> Reference) -> SuperGroup v -> SuperGroup v
forall v.
Var v =>
(Bool -> Reference -> Reference) -> SuperGroup v -> SuperGroup v
overGroupLinks Bool -> Reference -> Reference
rp) ((Reference, SuperGroup v) -> (Reference, SuperGroup v))
-> SCC (Reference, SuperGroup v) -> SCC (Reference, SuperGroup v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SCC (Reference, SuperGroup v)
scc0
        (Map Reference Reference
rm, Map Reference (SuperGroup v)
sgs) = SCC (Reference, SuperGroup v)
-> (Map Reference Reference, Map Reference (SuperGroup v))
forall v.
Var v =>
SCC (Reference, SuperGroup v)
-> (Map Reference Reference, Map Reference (SuperGroup v))
rehashSCC SCC (Reference, SuperGroup v)
scc

checkMissing ::
  (Var v) =>
  [(Referent, SuperGroup v)] ->
  Either (Text, [Referent]) [Reference]
checkMissing :: forall v.
Var v =>
[(Referent, SuperGroup v)] -> Either (Text, [Referent]) [Reference]
checkMissing ([(Referent, SuperGroup v)] -> ([Referent], [SuperGroup v])
forall a b. [(a, b)] -> ([a], [b])
unzip -> ([Referent]
rs, [SuperGroup v]
gs)) = do
  Set (Id' Hash)
is <- ([Id' Hash] -> Set (Id' Hash))
-> Either (Text, [Referent]) [Id' Hash]
-> Either (Text, [Referent]) (Set (Id' Hash))
forall a b.
(a -> b)
-> Either (Text, [Referent]) a -> Either (Text, [Referent]) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Id' Hash] -> Set (Id' Hash)
forall a. Ord a => [a] -> Set a
Set.fromList (Either (Text, [Referent]) [Id' Hash]
 -> Either (Text, [Referent]) (Set (Id' Hash)))
-> ([Referent] -> Either (Text, [Referent]) [Id' Hash])
-> [Referent]
-> Either (Text, [Referent]) (Set (Id' Hash))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Referent -> Either (Text, [Referent]) (Id' Hash))
-> [Referent] -> Either (Text, [Referent]) [Id' Hash]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Referent -> Either (Text, [Referent]) (Id' Hash)
forall {a}.
IsString a =>
Referent -> Either (a, [Referent]) (Id' Hash)
f ([Referent] -> Either (Text, [Referent]) (Set (Id' Hash)))
-> [Referent] -> Either (Text, [Referent]) (Set (Id' Hash))
forall a b. (a -> b) -> a -> b
$ [Referent]
rs
  [Reference] -> Either (Text, [Referent]) [Reference]
forall a. a -> Either (Text, [Referent]) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Reference] -> Either (Text, [Referent]) [Reference])
-> ([SuperGroup v] -> [Reference])
-> [SuperGroup v]
-> Either (Text, [Referent]) [Reference]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Reference] -> [Reference]
forall a. Eq a => [a] -> [a]
nub ([Reference] -> [Reference])
-> ([SuperGroup v] -> [Reference]) -> [SuperGroup v] -> [Reference]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SuperGroup v -> [Reference]) -> [SuperGroup v] -> [Reference]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Reference -> Bool) -> [Reference] -> [Reference]
forall a. (a -> Bool) -> [a] -> [a]
filter (Set (Id' Hash) -> Reference -> Bool
forall {t}. Set (Id' Hash) -> Reference' t Hash -> Bool
p Set (Id' Hash)
is) ([Reference] -> [Reference])
-> (SuperGroup v -> [Reference]) -> SuperGroup v -> [Reference]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuperGroup v -> [Reference]
forall v. Var v => SuperGroup v -> [Reference]
groupTermLinks) ([SuperGroup v] -> Either (Text, [Referent]) [Reference])
-> [SuperGroup v] -> Either (Text, [Referent]) [Reference]
forall a b. (a -> b) -> a -> b
$ [SuperGroup v]
gs
  where
    f :: Referent -> Either (a, [Referent]) (Id' Hash)
f (Ref (DerivedId Id' Hash
i)) = Id' Hash -> Either (a, [Referent]) (Id' Hash)
forall a. a -> Either (a, [Referent]) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Id' Hash
i
    f r :: Referent
r@Ref {} =
      (a, [Referent]) -> Either (a, [Referent]) (Id' Hash)
forall a b. a -> Either a b
Left (a
"loaded code cannot be associated to a builtin link", [Referent
r])
    f Referent
r =
      (a, [Referent]) -> Either (a, [Referent]) (Id' Hash)
forall a b. a -> Either a b
Left (a
"loaded code cannot be associated to a constructor", [Referent
r])

    p :: Set (Id' Hash) -> Reference' t Hash -> Bool
p Set (Id' Hash)
s (DerivedId Id' Hash
i) =
      (Id' Hash -> Bool) -> Set (Id' Hash) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Id' Hash
j -> Id' Hash -> Hash
idToHash Id' Hash
i Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Id' Hash -> Hash
idToHash Id' Hash
j) Set (Id' Hash)
s Bool -> Bool -> Bool
&& Bool -> Bool
not (Id' Hash -> Set (Id' Hash) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Id' Hash
i Set (Id' Hash)
s)
    p Set (Id' Hash)
_ Reference' t Hash
_ = Bool
False

rehashSCC ::
  (Var v) =>
  SCC (Reference, SuperGroup v) ->
  (Map.Map Reference Reference, Map.Map Reference (SuperGroup v))
rehashSCC :: forall v.
Var v =>
SCC (Reference, SuperGroup v)
-> (Map Reference Reference, Map Reference (SuperGroup v))
rehashSCC SCC (Reference, SuperGroup v)
scc
  | SCC (Reference, SuperGroup v) -> Bool
forall v. SCC (Reference, SuperGroup v) -> Bool
checkSCC SCC (Reference, SuperGroup v)
scc = (Map Reference Reference
refreps, Map Reference (SuperGroup v)
newSGs)
  where
    ps :: [(Reference, SuperGroup v)]
ps = ((Reference, SuperGroup v)
 -> (Reference, SuperGroup v) -> Ordering)
-> [(Reference, SuperGroup v)] -> [(Reference, SuperGroup v)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Reference, SuperGroup v) -> Reference)
-> (Reference, SuperGroup v)
-> (Reference, SuperGroup v)
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Reference, SuperGroup v) -> Reference
forall a b. (a, b) -> a
fst) ([(Reference, SuperGroup v)] -> [(Reference, SuperGroup v)])
-> [(Reference, SuperGroup v)] -> [(Reference, SuperGroup v)]
forall a b. (a -> b) -> a -> b
$ SCC (Reference, SuperGroup v) -> [(Reference, SuperGroup v)]
forall vertex. SCC vertex -> [vertex]
flattenSCC SCC (Reference, SuperGroup v)
scc
    sample :: Hash
sample = case (Reference, SuperGroup v) -> Reference
forall a b. (a, b) -> a
fst ((Reference, SuperGroup v) -> Reference)
-> (Reference, SuperGroup v) -> Reference
forall a b. (a -> b) -> a -> b
$ [(Reference, SuperGroup v)] -> (Reference, SuperGroup v)
forall a. HasCallStack => [a] -> a
head [(Reference, SuperGroup v)]
ps of
      Derived Hash
h FOp
_ -> Hash
h
      Reference
_ -> [Char] -> Hash
forall a. HasCallStack => [Char] -> a
error [Char]
"rehashSCC: impossible"
    bss :: [ByteString]
bss = ((Reference, SuperGroup v) -> ByteString)
-> [(Reference, SuperGroup v)] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Reference -> SuperGroup v -> ByteString)
-> (Reference, SuperGroup v) -> ByteString
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Reference -> SuperGroup v -> ByteString)
 -> (Reference, SuperGroup v) -> ByteString)
-> (Reference -> SuperGroup v -> ByteString)
-> (Reference, SuperGroup v)
-> ByteString
forall a b. (a -> b) -> a -> b
$ EnumMap FOp Text -> Reference -> SuperGroup v -> ByteString
forall v.
Var v =>
EnumMap FOp Text -> Reference -> SuperGroup v -> ByteString
serializeGroupForRehash EnumMap FOp Text
forall a. Monoid a => a
mempty) [(Reference, SuperGroup v)]
ps
    digest :: Digest Blake2b_256
digest =
      Context Blake2b_256 -> Digest Blake2b_256
forall a. HashAlgorithm a => Context a -> Digest a
hashFinalize (Context Blake2b_256 -> Digest Blake2b_256)
-> Context Blake2b_256 -> Digest Blake2b_256
forall a b. (a -> b) -> a -> b
$
        (Context Blake2b_256 -> ByteString -> Context Blake2b_256)
-> Context Blake2b_256 -> [ByteString] -> Context Blake2b_256
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
          (\Context Blake2b_256
cx -> Context Blake2b_256 -> [ByteString] -> Context Blake2b_256
forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
Context a -> [ba] -> Context a
hashUpdates Context Blake2b_256
cx ([ByteString] -> Context Blake2b_256)
-> (ByteString -> [ByteString])
-> ByteString
-> Context Blake2b_256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
toChunks)
          (Blake2b_256 -> Context Blake2b_256
forall alg. HashAlgorithm alg => alg -> Context alg
hashInitWith Blake2b_256
Blake2b_256)
          [ByteString]
bss
    newHash :: Hash
newHash = ByteString -> Hash
fromByteString (ByteString -> Hash)
-> (ByteString -> ByteString) -> ByteString -> Hash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteString -> ByteString
cons Word8
0 (ByteString -> Hash) -> ByteString -> Hash
forall a b. (a -> b) -> a -> b
$ Digest Blake2b_256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert Digest Blake2b_256
digest
    replace :: Reference -> Reference
replace (Derived Hash
h FOp
i)
      | Hash
h Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
sample = Hash -> FOp -> Reference
forall h t. h -> FOp -> Reference' t h
Derived Hash
newHash FOp
i
    replace Reference
r = Reference
r

    replace' :: SuperGroup v -> SuperGroup v
replace' = (Bool -> Reference -> Reference) -> SuperGroup v -> SuperGroup v
forall v.
Var v =>
(Bool -> Reference -> Reference) -> SuperGroup v -> SuperGroup v
overGroupLinks (\Bool
b Reference
r -> if Bool
b then Reference
r else Reference -> Reference
replace Reference
r)

    newSGs :: Map Reference (SuperGroup v)
newSGs = [(Reference, SuperGroup v)] -> Map Reference (SuperGroup v)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Reference, SuperGroup v)] -> Map Reference (SuperGroup v))
-> [(Reference, SuperGroup v)] -> Map Reference (SuperGroup v)
forall a b. (a -> b) -> a -> b
$ ((Reference, SuperGroup v) -> (Reference, SuperGroup v))
-> [(Reference, SuperGroup v)] -> [(Reference, SuperGroup v)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Reference -> Reference)
-> (SuperGroup v -> SuperGroup v)
-> (Reference, SuperGroup v)
-> (Reference, SuperGroup v)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Reference -> Reference
replace SuperGroup v -> SuperGroup v
replace') [(Reference, SuperGroup v)]
ps

    refreps :: Map Reference Reference
refreps = [(Reference, Reference)] -> Map Reference Reference
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Reference, Reference)] -> Map Reference Reference)
-> [(Reference, Reference)] -> Map Reference Reference
forall a b. (a -> b) -> a -> b
$ ((Reference, SuperGroup v) -> (Reference, Reference))
-> [(Reference, SuperGroup v)] -> [(Reference, Reference)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Reference
r, SuperGroup v
_) -> (Reference
r, Reference -> Reference
replace Reference
r)) [(Reference, SuperGroup v)]
ps
rehashSCC SCC (Reference, SuperGroup v)
scc = [Char] -> (Map Reference Reference, Map Reference (SuperGroup v))
forall a. HasCallStack => [Char] -> a
error ([Char] -> (Map Reference Reference, Map Reference (SuperGroup v)))
-> [Char]
-> (Map Reference Reference, Map Reference (SuperGroup v))
forall a b. (a -> b) -> a -> b
$ [Char]
"unexpected SCC:\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SCC (Reference, SuperGroup v) -> [Char]
forall a. Show a => a -> [Char]
show SCC (Reference, SuperGroup v)
scc

checkSCC :: SCC (Reference, SuperGroup v) -> Bool
checkSCC :: forall v. SCC (Reference, SuperGroup v) -> Bool
checkSCC AcyclicSCC {} = Bool
True
checkSCC (CyclicSCC []) = Bool
True
checkSCC (CyclicSCC ((Reference, SuperGroup v)
p : [(Reference, SuperGroup v)]
ps)) = ((Reference, SuperGroup v) -> Bool)
-> [(Reference, SuperGroup v)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Reference, SuperGroup v) -> (Reference, SuperGroup v) -> Bool
forall {a} {t} {b} {t} {b}.
Eq a =>
(Reference' t a, b) -> (Reference' t a, b) -> Bool
same (Reference, SuperGroup v)
p) [(Reference, SuperGroup v)]
ps
  where
    same :: (Reference' t a, b) -> (Reference' t a, b) -> Bool
same (Derived a
h FOp
_, b
_) (Derived a
h' FOp
_, b
_) = a
h a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
h'
    same (Reference' t a, b)
_ (Reference' t a, b)
_ = Bool
False