module Unison.Runtime.ANF.Rehash where

import Crypto.Hash
import Data.Bifunctor (bimap, 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.Symbol (Symbol)

checkGroupHashes ::
  [(Referent, Code)] ->
  Either (Text, [Referent]) (Either [Referent] [Referent])
checkGroupHashes :: [(Referent, Code)]
-> Either (Text, [Referent]) (Either [Referent] [Referent])
checkGroupHashes [(Referent, Code)]
rgs = case [(Referent, Code)] -> Either (Text, [Referent]) [Reference]
checkMissing [(Referent, Code)]
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 Symbol)
-> Either
     (Text, [Referent])
     (Map Reference Reference, Map Reference (SuperGroup Symbol))
rehashGroups (Map Reference (SuperGroup Symbol)
 -> Either
      (Text, [Referent])
      (Map Reference Reference, Map Reference (SuperGroup Symbol)))
-> ([(Reference, SuperGroup Symbol)]
    -> Map Reference (SuperGroup Symbol))
-> [(Reference, SuperGroup Symbol)]
-> Either
     (Text, [Referent])
     (Map Reference Reference, Map Reference (SuperGroup Symbol))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Reference, SuperGroup Symbol)]
-> Map Reference (SuperGroup Symbol)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Reference, SuperGroup Symbol)]
 -> Either
      (Text, [Referent])
      (Map Reference Reference, Map Reference (SuperGroup Symbol)))
-> [(Reference, SuperGroup Symbol)]
-> Either
     (Text, [Referent])
     (Map Reference Reference, Map Reference (SuperGroup Symbol))
forall a b. (a -> b) -> a -> b
$ (Referent -> Reference)
-> (Code -> SuperGroup Symbol)
-> (Referent, Code)
-> (Reference, SuperGroup Symbol)
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 Referent -> Reference
toReference Code -> SuperGroup Symbol
codeGroup ((Referent, Code) -> (Reference, SuperGroup Symbol))
-> [(Referent, Code)] -> [(Reference, SuperGroup Symbol)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Referent, Code)]
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 Symbol)
_) ->
        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 ::
  Map.Map Reference (SuperGroup Symbol) ->
  Either (Text, [Referent]) (Map.Map Reference Reference, Map.Map Reference (SuperGroup Symbol))
rehashGroups :: Map Reference (SuperGroup Symbol)
-> Either
     (Text, [Referent])
     (Map Reference Reference, Map Reference (SuperGroup Symbol))
rehashGroups Map Reference (SuperGroup Symbol)
m
  | [SCC (Reference, SuperGroup Symbol)]
badsccs <- (SCC (Reference, SuperGroup Symbol) -> Bool)
-> [SCC (Reference, SuperGroup Symbol)]
-> [SCC (Reference, SuperGroup Symbol)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (SCC (Reference, SuperGroup Symbol) -> Bool)
-> SCC (Reference, SuperGroup Symbol)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SCC (Reference, SuperGroup Symbol) -> Bool
forall a. SCC (Reference, a) -> Bool
checkSCC) [SCC (Reference, SuperGroup Symbol)]
sccs,
    Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [SCC (Reference, SuperGroup Symbol)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SCC (Reference, SuperGroup Symbol)]
badsccs =
      (Text, [Referent])
-> Either
     (Text, [Referent])
     (Map Reference Reference, Map Reference (SuperGroup Symbol))
forall a b. a -> Either a b
Left (Text
err, ((Reference, SuperGroup Symbol) -> Referent)
-> [(Reference, SuperGroup Symbol)] -> [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 Symbol) -> Reference)
-> (Reference, SuperGroup Symbol)
-> Referent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Reference, SuperGroup Symbol) -> Reference
forall a b. (a, b) -> a
fst) ([(Reference, SuperGroup Symbol)] -> [Referent])
-> (SCC (Reference, SuperGroup Symbol)
    -> [(Reference, SuperGroup Symbol)])
-> SCC (Reference, SuperGroup Symbol)
-> [Referent]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SCC (Reference, SuperGroup Symbol)
-> [(Reference, SuperGroup Symbol)]
forall vertex. SCC vertex -> [vertex]
flattenSCC (SCC (Reference, SuperGroup Symbol) -> [Referent])
-> [SCC (Reference, SuperGroup Symbol)] -> [Referent]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [SCC (Reference, SuperGroup Symbol)]
badsccs)
  | Bool
otherwise = (Map Reference Reference, Map Reference (SuperGroup Symbol))
-> Either
     (Text, [Referent])
     (Map Reference Reference, Map Reference (SuperGroup Symbol))
forall a b. b -> Either a b
Right ((Map Reference Reference, Map Reference (SuperGroup Symbol))
 -> Either
      (Text, [Referent])
      (Map Reference Reference, Map Reference (SuperGroup Symbol)))
-> (Map Reference Reference, Map Reference (SuperGroup Symbol))
-> Either
     (Text, [Referent])
     (Map Reference Reference, Map Reference (SuperGroup Symbol))
forall a b. (a -> b) -> a -> b
$ ((Map Reference Reference, Map Reference (SuperGroup Symbol))
 -> SCC (Reference, SuperGroup Symbol)
 -> (Map Reference Reference, Map Reference (SuperGroup Symbol)))
-> (Map Reference Reference, Map Reference (SuperGroup Symbol))
-> [SCC (Reference, SuperGroup Symbol)]
-> (Map Reference Reference, Map Reference (SuperGroup Symbol))
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 Symbol))
-> SCC (Reference, SuperGroup Symbol)
-> (Map Reference Reference, Map Reference (SuperGroup Symbol))
step (Map Reference Reference
forall k a. Map k a
Map.empty, Map Reference (SuperGroup Symbol)
forall k a. Map k a
Map.empty) [SCC (Reference, SuperGroup Symbol)]
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 Symbol)]
sccs = [((Reference, SuperGroup Symbol), Reference, [Reference])]
-> [SCC (Reference, SuperGroup Symbol)]
forall key node. Ord key => [(node, key, [key])] -> [SCC node]
stronglyConnComp ([((Reference, SuperGroup Symbol), Reference, [Reference])]
 -> [SCC (Reference, SuperGroup Symbol)])
-> ([(Reference, SuperGroup Symbol)]
    -> [((Reference, SuperGroup Symbol), Reference, [Reference])])
-> [(Reference, SuperGroup Symbol)]
-> [SCC (Reference, SuperGroup Symbol)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Reference, SuperGroup Symbol)
 -> ((Reference, SuperGroup Symbol), Reference, [Reference]))
-> [(Reference, SuperGroup Symbol)]
-> [((Reference, SuperGroup Symbol), Reference, [Reference])]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Reference, SuperGroup Symbol)
-> ((Reference, SuperGroup Symbol), Reference, [Reference])
forall {v} {b}.
Var v =>
(b, SuperGroup v) -> ((b, SuperGroup v), b, [Reference])
f ([(Reference, SuperGroup Symbol)]
 -> [SCC (Reference, SuperGroup Symbol)])
-> [(Reference, SuperGroup Symbol)]
-> [SCC (Reference, SuperGroup Symbol)]
forall a b. (a -> b) -> a -> b
$ Map Reference (SuperGroup Symbol)
-> [(Reference, SuperGroup Symbol)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Reference (SuperGroup Symbol)
m

    step :: (Map Reference Reference, Map Reference (SuperGroup Symbol))
-> SCC (Reference, SuperGroup Symbol)
-> (Map Reference Reference, Map Reference (SuperGroup Symbol))
step (Map Reference Reference
remap, Map Reference (SuperGroup Symbol)
newSGs) SCC (Reference, SuperGroup Symbol)
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 Symbol)
-> Map Reference (SuperGroup Symbol)
-> Map Reference (SuperGroup Symbol)
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map Reference (SuperGroup Symbol)
newSGs Map Reference (SuperGroup Symbol)
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 Symbol)
scc = (SuperGroup Symbol -> SuperGroup Symbol)
-> (Reference, SuperGroup Symbol) -> (Reference, SuperGroup Symbol)
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 Symbol -> SuperGroup Symbol
forall v.
Var v =>
(Bool -> Reference -> Reference) -> SuperGroup v -> SuperGroup v
overGroupLinks Bool -> Reference -> Reference
rp) ((Reference, SuperGroup Symbol) -> (Reference, SuperGroup Symbol))
-> SCC (Reference, SuperGroup Symbol)
-> SCC (Reference, SuperGroup Symbol)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SCC (Reference, SuperGroup Symbol)
scc0
        (Map Reference Reference
rm, Map Reference (SuperGroup Symbol)
sgs) = SCC (Reference, SuperGroup Symbol)
-> (Map Reference Reference, Map Reference (SuperGroup Symbol))
rehashSCC SCC (Reference, SuperGroup Symbol)
scc

checkMissing ::
  [(Referent, Code)] ->
  Either (Text, [Referent]) [Reference]
checkMissing :: [(Referent, Code)] -> Either (Text, [Referent]) [Reference]
checkMissing ([(Referent, Code)] -> ([Referent], [Code])
forall a b. [(a, b)] -> ([a], [b])
unzip -> ([Referent]
rs, [Code]
cs)) = 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])
-> ([Code] -> [Reference])
-> [Code]
-> 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])
-> ([Code] -> [Reference]) -> [Code] -> [Reference]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Code -> [Reference]) -> [Code] -> [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])
-> (Code -> [Reference]) -> Code -> [Reference]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuperGroup Symbol -> [Reference]
forall v. Var v => SuperGroup v -> [Reference]
groupTermLinks (SuperGroup Symbol -> [Reference])
-> (Code -> SuperGroup Symbol) -> Code -> [Reference]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> SuperGroup Symbol
codeGroup) ([Code] -> Either (Text, [Referent]) [Reference])
-> [Code] -> Either (Text, [Referent]) [Reference]
forall a b. (a -> b) -> a -> b
$ [Code]
cs
  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 ::
  SCC (Reference, SuperGroup Symbol) ->
  (Map.Map Reference Reference, Map.Map Reference (SuperGroup Symbol))
rehashSCC :: SCC (Reference, SuperGroup Symbol)
-> (Map Reference Reference, Map Reference (SuperGroup Symbol))
rehashSCC SCC (Reference, SuperGroup Symbol)
scc
  | SCC (Reference, SuperGroup Symbol) -> Bool
forall a. SCC (Reference, a) -> Bool
checkSCC SCC (Reference, SuperGroup Symbol)
scc = (Map Reference Reference
refreps, Map Reference (SuperGroup Symbol)
newSGs)
  where
    ps :: [(Reference, SuperGroup Symbol)]
ps = ((Reference, SuperGroup Symbol)
 -> (Reference, SuperGroup Symbol) -> Ordering)
-> [(Reference, SuperGroup Symbol)]
-> [(Reference, SuperGroup Symbol)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Reference, SuperGroup Symbol) -> Reference)
-> (Reference, SuperGroup Symbol)
-> (Reference, SuperGroup Symbol)
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Reference, SuperGroup Symbol) -> Reference
forall a b. (a, b) -> a
fst) ([(Reference, SuperGroup Symbol)]
 -> [(Reference, SuperGroup Symbol)])
-> [(Reference, SuperGroup Symbol)]
-> [(Reference, SuperGroup Symbol)]
forall a b. (a -> b) -> a -> b
$ SCC (Reference, SuperGroup Symbol)
-> [(Reference, SuperGroup Symbol)]
forall vertex. SCC vertex -> [vertex]
flattenSCC SCC (Reference, SuperGroup Symbol)
scc
    sample :: Hash
sample = case (Reference, SuperGroup Symbol) -> Reference
forall a b. (a, b) -> a
fst ((Reference, SuperGroup Symbol) -> Reference)
-> (Reference, SuperGroup Symbol) -> Reference
forall a b. (a -> b) -> a -> b
$ [(Reference, SuperGroup Symbol)] -> (Reference, SuperGroup Symbol)
forall a. HasCallStack => [a] -> a
head [(Reference, SuperGroup Symbol)]
ps of
      Derived Hash
h Pos
_ -> Hash
h
      Reference
_ -> [Char] -> Hash
forall a. HasCallStack => [Char] -> a
error [Char]
"rehashSCC: impossible"
    bss :: [ByteString]
bss = ((Reference, SuperGroup Symbol) -> ByteString)
-> [(Reference, SuperGroup Symbol)] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Reference -> SuperGroup Symbol -> ByteString)
-> (Reference, SuperGroup Symbol) -> ByteString
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Reference -> SuperGroup Symbol -> ByteString)
 -> (Reference, SuperGroup Symbol) -> ByteString)
-> (Reference -> SuperGroup Symbol -> ByteString)
-> (Reference, SuperGroup Symbol)
-> ByteString
forall a b. (a -> b) -> a -> b
$ Map ForeignFunc Text
-> Reference -> SuperGroup Symbol -> ByteString
forall v.
Var v =>
Map ForeignFunc Text -> Reference -> SuperGroup v -> ByteString
serializeGroupForRehash Map ForeignFunc Text
forall a. Monoid a => a
mempty) [(Reference, SuperGroup Symbol)]
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 Pos
i)
      | Hash
h Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
== Hash
sample = Hash -> Pos -> Reference
forall h t. h -> Pos -> Reference' t h
Derived Hash
newHash Pos
i
    replace Reference
r = Reference
r

    replace' :: SuperGroup Symbol -> SuperGroup Symbol
replace' = (Bool -> Reference -> Reference)
-> SuperGroup Symbol -> SuperGroup Symbol
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 Symbol)
newSGs = [(Reference, SuperGroup Symbol)]
-> Map Reference (SuperGroup Symbol)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Reference, SuperGroup Symbol)]
 -> Map Reference (SuperGroup Symbol))
-> [(Reference, SuperGroup Symbol)]
-> Map Reference (SuperGroup Symbol)
forall a b. (a -> b) -> a -> b
$ ((Reference, SuperGroup Symbol) -> (Reference, SuperGroup Symbol))
-> [(Reference, SuperGroup Symbol)]
-> [(Reference, SuperGroup Symbol)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Reference -> Reference)
-> (SuperGroup Symbol -> SuperGroup Symbol)
-> (Reference, SuperGroup Symbol)
-> (Reference, SuperGroup Symbol)
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 Symbol -> SuperGroup Symbol
replace') [(Reference, SuperGroup Symbol)]
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 Symbol) -> (Reference, Reference))
-> [(Reference, SuperGroup Symbol)] -> [(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 Symbol
_) -> (Reference
r, Reference -> Reference
replace Reference
r)) [(Reference, SuperGroup Symbol)]
ps
rehashSCC SCC (Reference, SuperGroup Symbol)
scc = [Char]
-> (Map Reference Reference, Map Reference (SuperGroup Symbol))
forall a. HasCallStack => [Char] -> a
error ([Char]
 -> (Map Reference Reference, Map Reference (SuperGroup Symbol)))
-> [Char]
-> (Map Reference Reference, Map Reference (SuperGroup Symbol))
forall a b. (a -> b) -> a -> b
$ [Char]
"unexpected SCC:\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SCC (Reference, SuperGroup Symbol) -> [Char]
forall a. Show a => a -> [Char]
show SCC (Reference, SuperGroup Symbol)
scc

checkSCC :: SCC (Reference, a) -> Bool
checkSCC :: forall a. SCC (Reference, a) -> Bool
checkSCC AcyclicSCC {} = Bool
True
checkSCC (CyclicSCC []) = Bool
True
checkSCC (CyclicSCC ((Reference, a)
p : [(Reference, a)]
ps)) = ((Reference, a) -> Bool) -> [(Reference, a)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Reference, a) -> (Reference, a) -> Bool
forall {a} {t} {b} {t} {b}.
Eq a =>
(Reference' t a, b) -> (Reference' t a, b) -> Bool
same (Reference, a)
p) [(Reference, a)]
ps
  where
    same :: (Reference' t a, b) -> (Reference' t a, b) -> Bool
same (Derived a
h Pos
_, b
_) (Derived a
h' Pos
_, 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