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 Reference)] ->
  Either (Text, [Referent]) (Either [Referent] [Referent])
checkGroupHashes :: [(Referent, Code Reference)]
-> Either (Text, [Referent]) (Either [Referent] [Referent])
checkGroupHashes [(Referent, Code Reference)]
rgs = case [(Referent, Code Reference)]
-> Either (Text, [Referent]) [Reference]
checkMissing [(Referent, Code Reference)]
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 Reference Symbol)
-> Either
     (Text, [Referent])
     (Map Reference Reference,
      Map Reference (SuperGroup Reference Symbol))
rehashGroups (Map Reference (SuperGroup Reference Symbol)
 -> Either
      (Text, [Referent])
      (Map Reference Reference,
       Map Reference (SuperGroup Reference Symbol)))
-> ([(Reference, SuperGroup Reference Symbol)]
    -> Map Reference (SuperGroup Reference Symbol))
-> [(Reference, SuperGroup Reference Symbol)]
-> Either
     (Text, [Referent])
     (Map Reference Reference,
      Map Reference (SuperGroup Reference Symbol))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Reference, SuperGroup Reference Symbol)]
-> Map Reference (SuperGroup Reference Symbol)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Reference, SuperGroup Reference Symbol)]
 -> Either
      (Text, [Referent])
      (Map Reference Reference,
       Map Reference (SuperGroup Reference Symbol)))
-> [(Reference, SuperGroup Reference Symbol)]
-> Either
     (Text, [Referent])
     (Map Reference Reference,
      Map Reference (SuperGroup Reference Symbol))
forall a b. (a -> b) -> a -> b
$ (Referent -> Reference)
-> (Code Reference -> SuperGroup Reference Symbol)
-> (Referent, Code Reference)
-> (Reference, SuperGroup Reference 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 Reference -> SuperGroup Reference Symbol
forall ref. Code ref -> SuperGroup ref Symbol
codeGroup ((Referent, Code Reference)
 -> (Reference, SuperGroup Reference Symbol))
-> [(Referent, Code Reference)]
-> [(Reference, SuperGroup Reference Symbol)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Referent, Code Reference)]
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 Reference 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 Reference Symbol) ->
  Either (Text, [Referent]) (Map.Map Reference Reference, Map.Map Reference (SuperGroup Reference Symbol))
rehashGroups :: Map Reference (SuperGroup Reference Symbol)
-> Either
     (Text, [Referent])
     (Map Reference Reference,
      Map Reference (SuperGroup Reference Symbol))
rehashGroups Map Reference (SuperGroup Reference Symbol)
m
  | [SCC (Reference, SuperGroup Reference Symbol)]
badsccs <- (SCC (Reference, SuperGroup Reference Symbol) -> Bool)
-> [SCC (Reference, SuperGroup Reference Symbol)]
-> [SCC (Reference, SuperGroup Reference Symbol)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (SCC (Reference, SuperGroup Reference Symbol) -> Bool)
-> SCC (Reference, SuperGroup Reference Symbol)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SCC (Reference, SuperGroup Reference Symbol) -> Bool
forall a. SCC (Reference, a) -> Bool
checkSCC) [SCC (Reference, SuperGroup Reference Symbol)]
sccs,
    Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [SCC (Reference, SuperGroup Reference Symbol)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SCC (Reference, SuperGroup Reference Symbol)]
badsccs =
      (Text, [Referent])
-> Either
     (Text, [Referent])
     (Map Reference Reference,
      Map Reference (SuperGroup Reference Symbol))
forall a b. a -> Either a b
Left (Text
err, ((Reference, SuperGroup Reference Symbol) -> Referent)
-> [(Reference, SuperGroup Reference 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 Reference Symbol) -> Reference)
-> (Reference, SuperGroup Reference Symbol)
-> Referent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Reference, SuperGroup Reference Symbol) -> Reference
forall a b. (a, b) -> a
fst) ([(Reference, SuperGroup Reference Symbol)] -> [Referent])
-> (SCC (Reference, SuperGroup Reference Symbol)
    -> [(Reference, SuperGroup Reference Symbol)])
-> SCC (Reference, SuperGroup Reference Symbol)
-> [Referent]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SCC (Reference, SuperGroup Reference Symbol)
-> [(Reference, SuperGroup Reference Symbol)]
forall vertex. SCC vertex -> [vertex]
flattenSCC (SCC (Reference, SuperGroup Reference Symbol) -> [Referent])
-> [SCC (Reference, SuperGroup Reference Symbol)] -> [Referent]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [SCC (Reference, SuperGroup Reference Symbol)]
badsccs)
  | Bool
otherwise = (Map Reference Reference,
 Map Reference (SuperGroup Reference Symbol))
-> Either
     (Text, [Referent])
     (Map Reference Reference,
      Map Reference (SuperGroup Reference Symbol))
forall a b. b -> Either a b
Right ((Map Reference Reference,
  Map Reference (SuperGroup Reference Symbol))
 -> Either
      (Text, [Referent])
      (Map Reference Reference,
       Map Reference (SuperGroup Reference Symbol)))
-> (Map Reference Reference,
    Map Reference (SuperGroup Reference Symbol))
-> Either
     (Text, [Referent])
     (Map Reference Reference,
      Map Reference (SuperGroup Reference Symbol))
forall a b. (a -> b) -> a -> b
$ ((Map Reference Reference,
  Map Reference (SuperGroup Reference Symbol))
 -> SCC (Reference, SuperGroup Reference Symbol)
 -> (Map Reference Reference,
     Map Reference (SuperGroup Reference Symbol)))
-> (Map Reference Reference,
    Map Reference (SuperGroup Reference Symbol))
-> [SCC (Reference, SuperGroup Reference Symbol)]
-> (Map Reference Reference,
    Map Reference (SuperGroup Reference 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 Reference Symbol))
-> SCC (Reference, SuperGroup Reference Symbol)
-> (Map Reference Reference,
    Map Reference (SuperGroup Reference Symbol))
step (Map Reference Reference
forall k a. Map k a
Map.empty, Map Reference (SuperGroup Reference Symbol)
forall k a. Map k a
Map.empty) [SCC (Reference, SuperGroup Reference Symbol)]
sccs
  where
    err :: Text
err = Text
"detected mutually recursive bindings with distinct hashes"
    f :: (b, SuperGroup ref v) -> ((b, SuperGroup ref v), b, [ref])
f p :: (b, SuperGroup ref v)
p@(b
r, SuperGroup ref v
sg) = ((b, SuperGroup ref v)
p, b
r, SuperGroup ref v -> [ref]
forall ref v. (Ord ref, Var v) => SuperGroup ref v -> [ref]
groupTermLinks SuperGroup ref v
sg)

    sccs :: [SCC (Reference, SuperGroup Reference Symbol)]
sccs = [((Reference, SuperGroup Reference Symbol), Reference,
  [Reference])]
-> [SCC (Reference, SuperGroup Reference Symbol)]
forall key node. Ord key => [(node, key, [key])] -> [SCC node]
stronglyConnComp ([((Reference, SuperGroup Reference Symbol), Reference,
   [Reference])]
 -> [SCC (Reference, SuperGroup Reference Symbol)])
-> ([(Reference, SuperGroup Reference Symbol)]
    -> [((Reference, SuperGroup Reference Symbol), Reference,
         [Reference])])
-> [(Reference, SuperGroup Reference Symbol)]
-> [SCC (Reference, SuperGroup Reference Symbol)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Reference, SuperGroup Reference Symbol)
 -> ((Reference, SuperGroup Reference Symbol), Reference,
     [Reference]))
-> [(Reference, SuperGroup Reference Symbol)]
-> [((Reference, SuperGroup Reference 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 Reference Symbol)
-> ((Reference, SuperGroup Reference Symbol), Reference,
    [Reference])
forall {v} {ref} {b}.
(Var v, Ord ref) =>
(b, SuperGroup ref v) -> ((b, SuperGroup ref v), b, [ref])
f ([(Reference, SuperGroup Reference Symbol)]
 -> [SCC (Reference, SuperGroup Reference Symbol)])
-> [(Reference, SuperGroup Reference Symbol)]
-> [SCC (Reference, SuperGroup Reference Symbol)]
forall a b. (a -> b) -> a -> b
$ Map Reference (SuperGroup Reference Symbol)
-> [(Reference, SuperGroup Reference Symbol)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Reference (SuperGroup Reference Symbol)
m

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

checkMissing ::
  [(Referent, Code Reference)] ->
  Either (Text, [Referent]) [Reference]
checkMissing :: [(Referent, Code Reference)]
-> Either (Text, [Referent]) [Reference]
checkMissing ([(Referent, Code Reference)] -> ([Referent], [Code Reference])
forall a b. [(a, b)] -> ([a], [b])
unzip -> ([Referent]
rs, [Code Reference]
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] -> [Reference])
-> [Code Reference]
-> 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] -> [Reference])
-> [Code Reference]
-> [Reference]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Code Reference -> [Reference]) -> [Code Reference] -> [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 -> [Reference]) -> Code Reference -> [Reference]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuperGroup Reference Symbol -> [Reference]
forall ref v. (Ord ref, Var v) => SuperGroup ref v -> [ref]
groupTermLinks (SuperGroup Reference Symbol -> [Reference])
-> (Code Reference -> SuperGroup Reference Symbol)
-> Code Reference
-> [Reference]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code Reference -> SuperGroup Reference Symbol
forall ref. Code ref -> SuperGroup ref Symbol
codeGroup) ([Code Reference] -> Either (Text, [Referent]) [Reference])
-> [Code Reference] -> Either (Text, [Referent]) [Reference]
forall a b. (a -> b) -> a -> b
$ [Code Reference]
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 Reference Symbol) ->
  ( Map.Map Reference Reference,
    Map.Map Reference (SuperGroup Reference Symbol)
  )
rehashSCC :: SCC (Reference, SuperGroup Reference Symbol)
-> (Map Reference Reference,
    Map Reference (SuperGroup Reference Symbol))
rehashSCC SCC (Reference, SuperGroup Reference Symbol)
scc
  | SCC (Reference, SuperGroup Reference Symbol) -> Bool
forall a. SCC (Reference, a) -> Bool
checkSCC SCC (Reference, SuperGroup Reference Symbol)
scc = (Map Reference Reference
refreps, Map Reference (SuperGroup Reference Symbol)
newSGs)
  where
    ps :: [(Reference, SuperGroup Reference Symbol)]
ps = ((Reference, SuperGroup Reference Symbol)
 -> (Reference, SuperGroup Reference Symbol) -> Ordering)
-> [(Reference, SuperGroup Reference Symbol)]
-> [(Reference, SuperGroup Reference Symbol)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Reference, SuperGroup Reference Symbol) -> Reference)
-> (Reference, SuperGroup Reference Symbol)
-> (Reference, SuperGroup Reference Symbol)
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Reference, SuperGroup Reference Symbol) -> Reference
forall a b. (a, b) -> a
fst) ([(Reference, SuperGroup Reference Symbol)]
 -> [(Reference, SuperGroup Reference Symbol)])
-> [(Reference, SuperGroup Reference Symbol)]
-> [(Reference, SuperGroup Reference Symbol)]
forall a b. (a -> b) -> a -> b
$ SCC (Reference, SuperGroup Reference Symbol)
-> [(Reference, SuperGroup Reference Symbol)]
forall vertex. SCC vertex -> [vertex]
flattenSCC SCC (Reference, SuperGroup Reference Symbol)
scc
    sample :: Hash
sample = case (Reference, SuperGroup Reference Symbol) -> Reference
forall a b. (a, b) -> a
fst ((Reference, SuperGroup Reference Symbol) -> Reference)
-> (Reference, SuperGroup Reference Symbol) -> Reference
forall a b. (a -> b) -> a -> b
$ [(Reference, SuperGroup Reference Symbol)]
-> (Reference, SuperGroup Reference Symbol)
forall a. HasCallStack => [a] -> a
head [(Reference, SuperGroup Reference 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 Reference Symbol) -> ByteString)
-> [(Reference, SuperGroup Reference Symbol)] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Reference -> SuperGroup Reference Symbol -> ByteString)
-> (Reference, SuperGroup Reference Symbol) -> ByteString
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Reference -> SuperGroup Reference Symbol -> ByteString
forall v.
Var v =>
Reference -> SuperGroup Reference v -> ByteString
serializeGroupForRehash) [(Reference, SuperGroup Reference 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 Reference Symbol -> SuperGroup Reference Symbol
replace' = (Bool -> Reference -> Reference)
-> SuperGroup Reference Symbol -> SuperGroup Reference Symbol
forall v ref0 ref1.
Var v =>
(Bool -> ref0 -> ref1) -> SuperGroup ref0 v -> SuperGroup ref1 v
overGroupLinks (\Bool
b Reference
r -> if Bool
b then Reference
r else Reference -> Reference
replace Reference
r)

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