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