module Unison.Merge.Diff
  ( nameBasedNamespaceDiff,
  )
where

import Data.Map.Strict qualified as Map
import Data.Semialign (alignWith)
import Data.Set qualified as Set
import Data.These (These (..))
import U.Codebase.Reference (TypeReference)
import Unison.ConstructorReference (GConstructorReference (..))
import Unison.DataDeclaration (Decl)
import Unison.DataDeclaration qualified as DataDeclaration
import Unison.DeclNameLookup (DeclNameLookup)
import Unison.DeclNameLookup qualified as DeclNameLookup
import Unison.Hash (Hash (Hash))
import Unison.HashQualifiedPrime qualified as HQ'
import Unison.Merge.DiffOp (DiffOp (..))
import Unison.Merge.PartialDeclNameLookup (PartialDeclNameLookup (..))
import Unison.Merge.Synhash qualified as Synhash
import Unison.Merge.Synhashed (Synhashed (..))
import Unison.Merge.ThreeWay (ThreeWay (..))
import Unison.Merge.ThreeWay qualified as ThreeWay
import Unison.Merge.TwoWay (TwoWay (..))
import Unison.Merge.Updated (Updated (..))
import Unison.Name (Name)
import Unison.Parser.Ann (Ann)
import Unison.Prelude hiding (catMaybes)
import Unison.PrettyPrintEnv (PrettyPrintEnv (..))
import Unison.PrettyPrintEnv qualified as Ppe
import Unison.Reference (Reference' (..), TermReference, TermReferenceId, TypeReferenceId)
import Unison.Referent (Referent)
import Unison.Referent qualified as Referent
import Unison.Symbol (Symbol)
import Unison.Syntax.Name qualified as Name
import Unison.Term (Term)
import Unison.Util.BiMultimap (BiMultimap)
import Unison.Util.BiMultimap qualified as BiMultimap
import Unison.Util.Defns (Defns (..), DefnsF2, DefnsF3, zipDefnsWith)

-- | @nameBasedNamespaceDiff db declNameLookups defns@ returns Alice's and Bob's name-based namespace diffs, each in the
-- form:
--
-- > terms :: Map Name (DiffOp (Synhashed Referent))
-- > types :: Map Name (DiffOp (Synhashed TypeReference))
--
-- where each name is paired with its diff-op (added, deleted, or updated), relative to the LCA between Alice and Bob's
-- branches. If the hash of a name did not change, it will not appear in the map.
nameBasedNamespaceDiff ::
  (HasCallStack) =>
  TwoWay DeclNameLookup ->
  PartialDeclNameLookup ->
  ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) ->
  Defns (Map TermReferenceId (Term Symbol Ann)) (Map TypeReferenceId (Decl Symbol Ann)) ->
  TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference)
nameBasedNamespaceDiff :: HasCallStack =>
TwoWay DeclNameLookup
-> PartialDeclNameLookup
-> ThreeWay
     (Defns (BiMultimap Referent Name) (BiMultimap Reference Name))
-> Defns
     (Map TermReferenceId (Term Symbol Ann))
     (Map TermReferenceId (Decl Symbol Ann))
-> TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent Reference)
nameBasedNamespaceDiff TwoWay DeclNameLookup
declNameLookups PartialDeclNameLookup
lcaDeclNameLookup ThreeWay
  (Defns (BiMultimap Referent Name) (BiMultimap Reference Name))
defns Defns
  (Map TermReferenceId (Term Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
hydratedDefns =
  let lcaHashes :: DefnsF2 (Map Name) Synhashed Referent Reference
lcaHashes = HasCallStack =>
PrettyPrintEnv
-> PartialDeclNameLookup
-> Defns (BiMultimap Referent Name) (BiMultimap Reference Name)
-> Defns
     (Map TermReferenceId (Term Symbol Ann))
     (Map TermReferenceId (Decl Symbol Ann))
-> DefnsF2 (Map Name) Synhashed Referent Reference
PrettyPrintEnv
-> PartialDeclNameLookup
-> Defns (BiMultimap Referent Name) (BiMultimap Reference Name)
-> Defns
     (Map TermReferenceId (Term Symbol Ann))
     (Map TermReferenceId (Decl Symbol Ann))
-> DefnsF2 (Map Name) Synhashed Referent Reference
synhashLcaDefns PrettyPrintEnv
ppe PartialDeclNameLookup
lcaDeclNameLookup ThreeWay
  (Defns (BiMultimap Referent Name) (BiMultimap Reference Name))
defns.lca Defns
  (Map TermReferenceId (Term Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
hydratedDefns
      hashes :: TwoWay (DefnsF2 (Map Name) Synhashed Referent Reference)
hashes = HasCallStack =>
PrettyPrintEnv
-> Defns
     (Map TermReferenceId (Term Symbol Ann))
     (Map TermReferenceId (Decl Symbol Ann))
-> DeclNameLookup
-> Defns (BiMultimap Referent Name) (BiMultimap Reference Name)
-> DefnsF2 (Map Name) Synhashed Referent Reference
PrettyPrintEnv
-> Defns
     (Map TermReferenceId (Term Symbol Ann))
     (Map TermReferenceId (Decl Symbol Ann))
-> DeclNameLookup
-> Defns (BiMultimap Referent Name) (BiMultimap Reference Name)
-> DefnsF2 (Map Name) Synhashed Referent Reference
synhashDefns PrettyPrintEnv
ppe Defns
  (Map TermReferenceId (Term Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
hydratedDefns (DeclNameLookup
 -> Defns (BiMultimap Referent Name) (BiMultimap Reference Name)
 -> DefnsF2 (Map Name) Synhashed Referent Reference)
-> TwoWay DeclNameLookup
-> TwoWay
     (Defns (BiMultimap Referent Name) (BiMultimap Reference Name)
      -> DefnsF2 (Map Name) Synhashed Referent Reference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TwoWay DeclNameLookup
declNameLookups TwoWay
  (Defns (BiMultimap Referent Name) (BiMultimap Reference Name)
   -> DefnsF2 (Map Name) Synhashed Referent Reference)
-> TwoWay
     (Defns (BiMultimap Referent Name) (BiMultimap Reference Name))
-> TwoWay (DefnsF2 (Map Name) Synhashed Referent Reference)
forall a b. TwoWay (a -> b) -> TwoWay a -> TwoWay b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ThreeWay
  (Defns (BiMultimap Referent Name) (BiMultimap Reference Name))
-> TwoWay
     (Defns (BiMultimap Referent Name) (BiMultimap Reference Name))
forall a. ThreeWay a -> TwoWay a
ThreeWay.forgetLca ThreeWay
  (Defns (BiMultimap Referent Name) (BiMultimap Reference Name))
defns
   in DefnsF2 (Map Name) Synhashed Referent Reference
-> DefnsF2 (Map Name) Synhashed Referent Reference
-> DefnsF3 (Map Name) DiffOp Synhashed Referent Reference
forall term typ.
DefnsF2 (Map Name) Synhashed term typ
-> DefnsF2 (Map Name) Synhashed term typ
-> DefnsF3 (Map Name) DiffOp Synhashed term typ
diffHashedNamespaceDefns DefnsF2 (Map Name) Synhashed Referent Reference
lcaHashes (DefnsF2 (Map Name) Synhashed Referent Reference
 -> DefnsF3 (Map Name) DiffOp Synhashed Referent Reference)
-> TwoWay (DefnsF2 (Map Name) Synhashed Referent Reference)
-> TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent Reference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TwoWay (DefnsF2 (Map Name) Synhashed Referent Reference)
hashes
  where
    ppe :: PrettyPrintEnv
    ppe :: PrettyPrintEnv
ppe =
      -- The order between Alice and Bob isn't important here for syntactic hashing; not sure right now if it matters
      -- that the LCA is added last
      Defns (BiMultimap Referent Name) (BiMultimap Reference Name)
-> PrettyPrintEnv
deepNamespaceDefinitionsToPpe ThreeWay
  (Defns (BiMultimap Referent Name) (BiMultimap Reference Name))
defns.alice
        PrettyPrintEnv -> PrettyPrintEnv -> PrettyPrintEnv
`Ppe.addFallback` Defns (BiMultimap Referent Name) (BiMultimap Reference Name)
-> PrettyPrintEnv
deepNamespaceDefinitionsToPpe ThreeWay
  (Defns (BiMultimap Referent Name) (BiMultimap Reference Name))
defns.bob
        PrettyPrintEnv -> PrettyPrintEnv -> PrettyPrintEnv
`Ppe.addFallback` Defns (BiMultimap Referent Name) (BiMultimap Reference Name)
-> PrettyPrintEnv
deepNamespaceDefinitionsToPpe ThreeWay
  (Defns (BiMultimap Referent Name) (BiMultimap Reference Name))
defns.lca

diffHashedNamespaceDefns ::
  DefnsF2 (Map Name) Synhashed term typ ->
  DefnsF2 (Map Name) Synhashed term typ ->
  DefnsF3 (Map Name) DiffOp Synhashed term typ
diffHashedNamespaceDefns :: forall term typ.
DefnsF2 (Map Name) Synhashed term typ
-> DefnsF2 (Map Name) Synhashed term typ
-> DefnsF3 (Map Name) DiffOp Synhashed term typ
diffHashedNamespaceDefns =
  (Map Name (Synhashed term)
 -> Map Name (Synhashed term) -> Map Name (DiffOp (Synhashed term)))
-> (Map Name (Synhashed typ)
    -> Map Name (Synhashed typ) -> Map Name (DiffOp (Synhashed typ)))
-> Defns (Map Name (Synhashed term)) (Map Name (Synhashed typ))
-> Defns (Map Name (Synhashed term)) (Map Name (Synhashed typ))
-> Defns
     (Map Name (DiffOp (Synhashed term)))
     (Map Name (DiffOp (Synhashed typ)))
forall tm1 tm2 tm3 ty1 ty2 ty3.
(tm1 -> tm2 -> tm3)
-> (ty1 -> ty2 -> ty3)
-> Defns tm1 ty1
-> Defns tm2 ty2
-> Defns tm3 ty3
zipDefnsWith Map Name (Synhashed term)
-> Map Name (Synhashed term) -> Map Name (DiffOp (Synhashed term))
forall ref.
Map Name (Synhashed ref)
-> Map Name (Synhashed ref) -> Map Name (DiffOp (Synhashed ref))
f Map Name (Synhashed typ)
-> Map Name (Synhashed typ) -> Map Name (DiffOp (Synhashed typ))
forall ref.
Map Name (Synhashed ref)
-> Map Name (Synhashed ref) -> Map Name (DiffOp (Synhashed ref))
f
  where
    f :: Map Name (Synhashed ref) -> Map Name (Synhashed ref) -> Map Name (DiffOp (Synhashed ref))
    f :: forall ref.
Map Name (Synhashed ref)
-> Map Name (Synhashed ref) -> Map Name (DiffOp (Synhashed ref))
f Map Name (Synhashed ref)
old Map Name (Synhashed ref)
new =
      (Maybe (DiffOp (Synhashed ref)) -> Maybe (DiffOp (Synhashed ref)))
-> Map Name (Maybe (DiffOp (Synhashed ref)))
-> Map Name (DiffOp (Synhashed ref))
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe Maybe (DiffOp (Synhashed ref)) -> Maybe (DiffOp (Synhashed ref))
forall a. a -> a
id ((These (Synhashed ref) (Synhashed ref)
 -> Maybe (DiffOp (Synhashed ref)))
-> Map Name (Synhashed ref)
-> Map Name (Synhashed ref)
-> Map Name (Maybe (DiffOp (Synhashed ref)))
forall a b c.
(These a b -> c) -> Map Name a -> Map Name b -> Map Name c
forall (f :: * -> *) a b c.
Semialign f =>
(These a b -> c) -> f a -> f b -> f c
alignWith These (Synhashed ref) (Synhashed ref)
-> Maybe (DiffOp (Synhashed ref))
forall x. Eq x => These x x -> Maybe (DiffOp x)
g Map Name (Synhashed ref)
old Map Name (Synhashed ref)
new)

    g :: (Eq x) => These x x -> Maybe (DiffOp x)
    g :: forall x. Eq x => These x x -> Maybe (DiffOp x)
g = \case
      This x
old -> DiffOp x -> Maybe (DiffOp x)
forall a. a -> Maybe a
Just (x -> DiffOp x
forall a. a -> DiffOp a
DiffOp'Delete x
old)
      That x
new -> DiffOp x -> Maybe (DiffOp x)
forall a. a -> Maybe a
Just (x -> DiffOp x
forall a. a -> DiffOp a
DiffOp'Add x
new)
      These x
old x
new
        | x
old x -> x -> Bool
forall a. Eq a => a -> a -> Bool
== x
new -> Maybe (DiffOp x)
forall a. Maybe a
Nothing
        | Bool
otherwise -> DiffOp x -> Maybe (DiffOp x)
forall a. a -> Maybe a
Just (Updated x -> DiffOp x
forall a. Updated a -> DiffOp a
DiffOp'Update Updated {x
old :: x
$sel:old:Updated :: x
old, x
new :: x
$sel:new:Updated :: x
new})

------------------------------------------------------------------------------------------------------------------------
-- Syntactic hashing

synhashLcaDefns ::
  (HasCallStack) =>
  PrettyPrintEnv ->
  PartialDeclNameLookup ->
  Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name) ->
  Defns (Map TermReferenceId (Term Symbol Ann)) (Map TypeReferenceId (Decl Symbol Ann)) ->
  DefnsF2 (Map Name) Synhashed Referent TypeReference
synhashLcaDefns :: HasCallStack =>
PrettyPrintEnv
-> PartialDeclNameLookup
-> Defns (BiMultimap Referent Name) (BiMultimap Reference Name)
-> Defns
     (Map TermReferenceId (Term Symbol Ann))
     (Map TermReferenceId (Decl Symbol Ann))
-> DefnsF2 (Map Name) Synhashed Referent Reference
synhashLcaDefns PrettyPrintEnv
ppe PartialDeclNameLookup
declNameLookup Defns (BiMultimap Referent Name) (BiMultimap Reference Name)
defns Defns
  (Map TermReferenceId (Term Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
hydratedDefns =
  (Name -> Referent -> Hash)
-> (Name -> Reference -> Hash)
-> Defns (BiMultimap Referent Name) (BiMultimap Reference Name)
-> DefnsF2 (Map Name) Synhashed Referent Reference
forall term typ.
HasCallStack =>
(Name -> term -> Hash)
-> (Name -> typ -> Hash)
-> Defns (BiMultimap term Name) (BiMultimap typ Name)
-> DefnsF2 (Map Name) Synhashed term typ
synhashDefnsWith Name -> Referent -> Hash
hashReferent Name -> Reference -> Hash
hashType Defns (BiMultimap Referent Name) (BiMultimap Reference Name)
defns
  where
    -- For the LCA only, if we don't have a name for every constructor, or we don't have a name for a decl, that's okay,
    -- just use a dummy syntactic hash (e.g. where we return `Hash mempty` below in two places).
    --
    -- This is safe and correct; Alice/Bob can't have such a decl (it violates a merge precondition), so there's no risk
    -- that we accidentally get an equal hash and classify a real update as unchanged.

    hashReferent :: Name -> Referent -> Hash
    hashReferent :: Name -> Referent -> Hash
hashReferent Name
name = \case
      Referent.Con (ConstructorReference Reference
ref ConstructorId
_) ConstructorType
_ ->
        case Name -> Map Name Name -> Maybe Name
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
name PartialDeclNameLookup
declNameLookup.constructorToDecl of
          Maybe Name
Nothing -> ShortByteString -> Hash
Hash ShortByteString
forall a. Monoid a => a
mempty -- see note above
          Just Name
declName -> Name -> Reference -> Hash
hashType Name
declName Reference
ref
      Referent.Ref Reference
ref -> HasCallStack =>
PrettyPrintEnv
-> Map TermReferenceId (Term Symbol Ann) -> Reference -> Hash
PrettyPrintEnv
-> Map TermReferenceId (Term Symbol Ann) -> Reference -> Hash
synhashTermReference PrettyPrintEnv
ppe Defns
  (Map TermReferenceId (Term Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
hydratedDefns.terms Reference
ref

    hashType :: Name -> TypeReference -> Hash
    hashType :: Name -> Reference -> Hash
hashType Name
name = \case
      ReferenceBuiltin Text
builtin -> Text -> Hash
Synhash.synhashBuiltinDecl Text
builtin
      ReferenceDerived TermReferenceId
ref ->
        case [Maybe Name] -> Maybe [Name]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence (PartialDeclNameLookup
declNameLookup.declToConstructors Map Name [Maybe Name] -> Name -> [Maybe Name]
forall k a. Ord k => Map k a -> k -> a
Map.! Name
name) of
          Maybe [Name]
Nothing -> ShortByteString -> Hash
Hash ShortByteString
forall a. Monoid a => a
mempty -- see note above
          Just [Name]
names -> HasCallStack =>
PrettyPrintEnv
-> Map TermReferenceId (Decl Symbol Ann)
-> [Name]
-> Name
-> TermReferenceId
-> Hash
PrettyPrintEnv
-> Map TermReferenceId (Decl Symbol Ann)
-> [Name]
-> Name
-> TermReferenceId
-> Hash
synhashDerivedDecl PrettyPrintEnv
ppe Defns
  (Map TermReferenceId (Term Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
hydratedDefns.types [Name]
names Name
name TermReferenceId
ref

synhashDefns ::
  (HasCallStack) =>
  PrettyPrintEnv ->
  Defns (Map TermReferenceId (Term Symbol Ann)) (Map TypeReferenceId (Decl Symbol Ann)) ->
  DeclNameLookup ->
  Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name) ->
  DefnsF2 (Map Name) Synhashed Referent TypeReference
synhashDefns :: HasCallStack =>
PrettyPrintEnv
-> Defns
     (Map TermReferenceId (Term Symbol Ann))
     (Map TermReferenceId (Decl Symbol Ann))
-> DeclNameLookup
-> Defns (BiMultimap Referent Name) (BiMultimap Reference Name)
-> DefnsF2 (Map Name) Synhashed Referent Reference
synhashDefns PrettyPrintEnv
ppe Defns
  (Map TermReferenceId (Term Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
hydratedDefns DeclNameLookup
declNameLookup =
  (Name -> Referent -> Hash)
-> (Name -> Reference -> Hash)
-> Defns (BiMultimap Referent Name) (BiMultimap Reference Name)
-> DefnsF2 (Map Name) Synhashed Referent Reference
forall term typ.
HasCallStack =>
(Name -> term -> Hash)
-> (Name -> typ -> Hash)
-> Defns (BiMultimap term Name) (BiMultimap typ Name)
-> DefnsF2 (Map Name) Synhashed term typ
synhashDefnsWith Name -> Referent -> Hash
hashReferent Name -> Reference -> Hash
hashType
  where
    hashReferent :: Name -> Referent -> Hash
    hashReferent :: Name -> Referent -> Hash
hashReferent Name
name = \case
      -- We say that a referent constructor *in the namespace* (distinct from a referent that is in a term body) has a
      -- synhash that is simply equal to the synhash of its type declaration. This is because the type declaration and
      -- constructors are changed in lock-step: it is not possible to change one, but not the other.
      --
      -- For example, if Alice updates `type Foo = Bar Nat` to `type Foo = Bar Nat Nat`, we want different synhashes on
      -- both the type (Foo) and the constructor (Foo.Bar).
      Referent.Con (ConstructorReference Reference
ref ConstructorId
_) ConstructorType
_ -> Name -> Reference -> Hash
hashType (HasCallStack => DeclNameLookup -> Name -> Name
DeclNameLookup -> Name -> Name
DeclNameLookup.expectDeclName DeclNameLookup
declNameLookup Name
name) Reference
ref
      Referent.Ref Reference
ref -> HasCallStack =>
PrettyPrintEnv
-> Map TermReferenceId (Term Symbol Ann) -> Reference -> Hash
PrettyPrintEnv
-> Map TermReferenceId (Term Symbol Ann) -> Reference -> Hash
synhashTermReference PrettyPrintEnv
ppe Defns
  (Map TermReferenceId (Term Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
hydratedDefns.terms Reference
ref

    hashType :: Name -> TypeReference -> Hash
    hashType :: Name -> Reference -> Hash
hashType Name
name = \case
      ReferenceBuiltin Text
builtin -> Text -> Hash
Synhash.synhashBuiltinDecl Text
builtin
      ReferenceDerived TermReferenceId
ref ->
        HasCallStack =>
PrettyPrintEnv
-> Map TermReferenceId (Decl Symbol Ann)
-> [Name]
-> Name
-> TermReferenceId
-> Hash
PrettyPrintEnv
-> Map TermReferenceId (Decl Symbol Ann)
-> [Name]
-> Name
-> TermReferenceId
-> Hash
synhashDerivedDecl PrettyPrintEnv
ppe Defns
  (Map TermReferenceId (Term Symbol Ann))
  (Map TermReferenceId (Decl Symbol Ann))
hydratedDefns.types (HasCallStack => DeclNameLookup -> Name -> [Name]
DeclNameLookup -> Name -> [Name]
DeclNameLookup.expectConstructorNames DeclNameLookup
declNameLookup Name
name) Name
name TermReferenceId
ref

synhashDerivedDecl ::
  (HasCallStack) =>
  PrettyPrintEnv ->
  Map TypeReferenceId (Decl Symbol Ann) ->
  [Name] ->
  Name ->
  TypeReferenceId ->
  Hash
synhashDerivedDecl :: HasCallStack =>
PrettyPrintEnv
-> Map TermReferenceId (Decl Symbol Ann)
-> [Name]
-> Name
-> TermReferenceId
-> Hash
synhashDerivedDecl PrettyPrintEnv
ppe Map TermReferenceId (Decl Symbol Ann)
declsById [Name]
names Name
name TermReferenceId
ref =
  Map TermReferenceId (Decl Symbol Ann)
declsById
    Map TermReferenceId (Decl Symbol Ann)
-> (Map TermReferenceId (Decl Symbol Ann) -> Decl Symbol Ann)
-> Decl Symbol Ann
forall a b. a -> (a -> b) -> b
& HasCallStack =>
TermReferenceId
-> Map TermReferenceId (Decl Symbol Ann) -> Decl Symbol Ann
TermReferenceId
-> Map TermReferenceId (Decl Symbol Ann) -> Decl Symbol Ann
expectDecl TermReferenceId
ref
    Decl Symbol Ann
-> (Decl Symbol Ann -> Decl Symbol Ann) -> Decl Symbol Ann
forall a b. a -> (a -> b) -> b
& [Symbol] -> Decl Symbol Ann -> Decl Symbol Ann
forall v a. [v] -> Decl v a -> Decl v a
DataDeclaration.setConstructorNames ((Name -> Symbol) -> [Name] -> [Symbol]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Symbol
forall v. Var v => Name -> v
Name.toVar [Name]
names)
    Decl Symbol Ann -> (Decl Symbol Ann -> Hash) -> Hash
forall a b. a -> (a -> b) -> b
& PrettyPrintEnv -> Name -> Decl Symbol Ann -> Hash
forall v a. Var v => PrettyPrintEnv -> Name -> Decl v a -> Hash
Synhash.synhashDerivedDecl PrettyPrintEnv
ppe Name
name

synhashTermReference :: (HasCallStack) => PrettyPrintEnv -> Map TermReferenceId (Term Symbol Ann) -> TermReference -> Hash
synhashTermReference :: HasCallStack =>
PrettyPrintEnv
-> Map TermReferenceId (Term Symbol Ann) -> Reference -> Hash
synhashTermReference PrettyPrintEnv
ppe Map TermReferenceId (Term Symbol Ann)
termsById = \case
  ReferenceBuiltin Text
builtin -> Text -> Hash
Synhash.synhashBuiltinTerm Text
builtin
  ReferenceDerived TermReferenceId
ref -> PrettyPrintEnv -> Term Symbol Ann -> Hash
forall v a. Var v => PrettyPrintEnv -> Term v a -> Hash
Synhash.synhashDerivedTerm PrettyPrintEnv
ppe (HasCallStack =>
TermReferenceId
-> Map TermReferenceId (Term Symbol Ann) -> Term Symbol Ann
TermReferenceId
-> Map TermReferenceId (Term Symbol Ann) -> Term Symbol Ann
expectTerm TermReferenceId
ref Map TermReferenceId (Term Symbol Ann)
termsById)

synhashDefnsWith ::
  (HasCallStack) =>
  (Name -> term -> Hash) ->
  (Name -> typ -> Hash) ->
  Defns (BiMultimap term Name) (BiMultimap typ Name) ->
  DefnsF2 (Map Name) Synhashed term typ
synhashDefnsWith :: forall term typ.
HasCallStack =>
(Name -> term -> Hash)
-> (Name -> typ -> Hash)
-> Defns (BiMultimap term Name) (BiMultimap typ Name)
-> DefnsF2 (Map Name) Synhashed term typ
synhashDefnsWith Name -> term -> Hash
hashTerm Name -> typ -> Hash
hashType = do
  (BiMultimap term Name -> Map Name (Synhashed term))
-> (BiMultimap typ Name -> Map Name (Synhashed typ))
-> Defns (BiMultimap term Name) (BiMultimap typ Name)
-> DefnsF2 (Map Name) Synhashed term typ
forall a b c d. (a -> b) -> (c -> d) -> Defns a c -> Defns b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap
    ((Name -> term -> Synhashed term)
-> Map Name term -> Map Name (Synhashed term)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey Name -> term -> Synhashed term
hashTerm1 (Map Name term -> Map Name (Synhashed term))
-> (BiMultimap term Name -> Map Name term)
-> BiMultimap term Name
-> Map Name (Synhashed term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BiMultimap term Name -> Map Name term
forall a b. BiMultimap a b -> Map b a
BiMultimap.range)
    ((Name -> typ -> Synhashed typ)
-> Map Name typ -> Map Name (Synhashed typ)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey Name -> typ -> Synhashed typ
hashType1 (Map Name typ -> Map Name (Synhashed typ))
-> (BiMultimap typ Name -> Map Name typ)
-> BiMultimap typ Name
-> Map Name (Synhashed typ)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BiMultimap typ Name -> Map Name typ
forall a b. BiMultimap a b -> Map b a
BiMultimap.range)
  where
    hashTerm1 :: Name -> term -> Synhashed term
hashTerm1 Name
name term
term =
      Hash -> term -> Synhashed term
forall a. Hash -> a -> Synhashed a
Synhashed (Name -> term -> Hash
hashTerm Name
name term
term) term
term

    hashType1 :: Name -> typ -> Synhashed typ
hashType1 Name
name typ
typ =
      Hash -> typ -> Synhashed typ
forall a. Hash -> a -> Synhashed a
Synhashed (Name -> typ -> Hash
hashType Name
name typ
typ) typ
typ

------------------------------------------------------------------------------------------------------------------------
-- Pretty-print env helpers

deepNamespaceDefinitionsToPpe :: Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name) -> PrettyPrintEnv
deepNamespaceDefinitionsToPpe :: Defns (BiMultimap Referent Name) (BiMultimap Reference Name)
-> PrettyPrintEnv
deepNamespaceDefinitionsToPpe Defns {BiMultimap Referent Name
terms :: BiMultimap Referent Name
$sel:terms:Defns :: forall terms types. Defns terms types -> terms
terms, BiMultimap Reference Name
types :: BiMultimap Reference Name
$sel:types:Defns :: forall terms types. Defns terms types -> types
types} =
  (Referent -> [(HashQualified Name, HashQualified Name)])
-> (Reference -> [(HashQualified Name, HashQualified Name)])
-> PrettyPrintEnv
PrettyPrintEnv (BiMultimap Referent Name
-> Referent -> [(HashQualified Name, HashQualified Name)]
forall ref.
Ord ref =>
BiMultimap ref Name
-> ref -> [(HashQualified Name, HashQualified Name)]
arbitraryName BiMultimap Referent Name
terms) (BiMultimap Reference Name
-> Reference -> [(HashQualified Name, HashQualified Name)]
forall ref.
Ord ref =>
BiMultimap ref Name
-> ref -> [(HashQualified Name, HashQualified Name)]
arbitraryName BiMultimap Reference Name
types)
  where
    arbitraryName :: (Ord ref) => BiMultimap ref Name -> ref -> [(HQ'.HashQualified Name, HQ'.HashQualified Name)]
    arbitraryName :: forall ref.
Ord ref =>
BiMultimap ref Name
-> ref -> [(HashQualified Name, HashQualified Name)]
arbitraryName BiMultimap ref Name
names ref
ref =
      ref -> BiMultimap ref Name -> Set Name
forall a b. Ord a => a -> BiMultimap a b -> Set b
BiMultimap.lookupDom ref
ref BiMultimap ref Name
names
        Set Name -> (Set Name -> Maybe Name) -> Maybe Name
forall a b. a -> (a -> b) -> b
& Set Name -> Maybe Name
forall a. Set a -> Maybe a
Set.lookupMin
        Maybe Name
-> (Maybe Name -> [(HashQualified Name, HashQualified Name)])
-> [(HashQualified Name, HashQualified Name)]
forall a b. a -> (a -> b) -> b
& [(HashQualified Name, HashQualified Name)]
-> (Name -> [(HashQualified Name, HashQualified Name)])
-> Maybe Name
-> [(HashQualified Name, HashQualified Name)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] \Name
name -> [(Name -> HashQualified Name
forall n. n -> HashQualified n
HQ'.NameOnly Name
name, Name -> HashQualified Name
forall n. n -> HashQualified n
HQ'.NameOnly Name
name)]

------------------------------------------------------------------------------------------------------------------------
-- Looking up terms and decls that we expect to be there

expectTerm :: (HasCallStack) => TermReferenceId -> Map TermReferenceId (Term Symbol Ann) -> Term Symbol Ann
expectTerm :: HasCallStack =>
TermReferenceId
-> Map TermReferenceId (Term Symbol Ann) -> Term Symbol Ann
expectTerm TermReferenceId
ref Map TermReferenceId (Term Symbol Ann)
termsById =
  case TermReferenceId
-> Map TermReferenceId (Term Symbol Ann) -> Maybe (Term Symbol Ann)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TermReferenceId
ref Map TermReferenceId (Term Symbol Ann)
termsById of
    Maybe (Term Symbol Ann)
Nothing -> [Char] -> Term Symbol Ann
forall a. HasCallStack => [Char] -> a
error ([Char] -> [Char] -> [Char]
reportBug [Char]
"E488229" ([Char]
"term ref " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TermReferenceId -> [Char]
forall a. Show a => a -> [Char]
show TermReferenceId
ref [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not found in map " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Map TermReferenceId (Term Symbol Ann) -> [Char]
forall a. Show a => a -> [Char]
show Map TermReferenceId (Term Symbol Ann)
termsById))
    Just Term Symbol Ann
term -> Term Symbol Ann
term

expectDecl :: (HasCallStack) => TypeReferenceId -> Map TypeReferenceId (Decl Symbol Ann) -> Decl Symbol Ann
expectDecl :: HasCallStack =>
TermReferenceId
-> Map TermReferenceId (Decl Symbol Ann) -> Decl Symbol Ann
expectDecl TermReferenceId
ref Map TermReferenceId (Decl Symbol Ann)
declsById =
  case TermReferenceId
-> Map TermReferenceId (Decl Symbol Ann) -> Maybe (Decl Symbol Ann)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TermReferenceId
ref Map TermReferenceId (Decl Symbol Ann)
declsById of
    Maybe (Decl Symbol Ann)
Nothing -> [Char] -> Decl Symbol Ann
forall a. HasCallStack => [Char] -> a
error ([Char] -> [Char] -> [Char]
reportBug [Char]
"E663160" ([Char]
"type ref " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TermReferenceId -> [Char]
forall a. Show a => a -> [Char]
show TermReferenceId
ref [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not found in map " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Map TermReferenceId (Decl Symbol Ann) -> [Char]
forall a. Show a => a -> [Char]
show Map TermReferenceId (Decl Symbol Ann)
declsById))
    Just Decl Symbol Ann
decl -> Decl Symbol Ann
decl