-- | Utilities for computing the "syntactic hash" of a decl or term, which is a hash that is computed after substituting
-- references to other terms and decls with names from a pretty-print environment.
--
-- Thus, syntactic hashes can be compared for equality to answer questions like "would these definitions look the same
-- when rendered for a human (even if their underlying references are different)?".
--
-- The merge algorithm currently uses syntactic hashes for determining whether an update was performed by a human, or
-- was the result of auto-propagation. (Critically, this cannot handle renames very well). For example, consider
-- comparing two definitions on Alice's branch; one old one from somewhere in its history, and one new:
--
--   old namespace        new namespace
--   ----------------     ---------------
--   foo = #bar + 3       foo = #bar2 + 3
--
-- Either Alice manually updated #bar to #bar2, or else a dependency of #bar was updated, inducing an update to #bar2.
-- Computing the syntactic hash can help answer that question. Let's combine a pretty-print environment for the old
-- and new namespaces together, substitute references with it, and look again at the terms:
--
--   old namespace        new namespace
--   ----------------     ----------------
--   foo = helper + 3     foo = helper + 3
--
-- We see now that our pretty-print environment has mapped both #bar and #bar2 to the name "helper", so each version of
-- "foo" would have the same syntactic hash. This indicates (to our merge algorithm) that this was an auto-propagated
-- update.
module Unison.Merge.Synhash
  ( synhashLcaDefns,
    synhashDefns,

    -- * Exported for debugging
    hashBuiltinTermTokens,
    hashDerivedTermTokens,
  )
where

import Data.Char (ord)
import Data.List qualified as List
import Data.Map.Strict qualified as Map
import Data.Text qualified as Text
import U.Codebase.Reference (TypeReference)
import Unison.ABT qualified as ABT
import Unison.ConstructorReference (GConstructorReference (..))
import Unison.ConstructorType (ConstructorType)
import Unison.ConstructorType qualified as CT
import Unison.DataDeclaration (DataDeclaration, Decl)
import Unison.DataDeclaration qualified as DD
import Unison.DataDeclaration qualified as DataDeclaration
import Unison.DeclNameLookup (DeclNameLookup)
import Unison.DeclNameLookup qualified as DeclNameLookup
import Unison.Hash (Hash (Hash))
import Unison.HashQualified as HQ
import Unison.Hashable qualified as H
import Unison.Kind qualified as K
import Unison.Merge.Synhashed (Synhashed (..))
import Unison.Name (Name)
import Unison.Name qualified as Name
import Unison.Parser.Ann (Ann)
import Unison.PartialDeclNameLookup (PartialDeclNameLookup (..))
import Unison.Pattern qualified as Pattern
import Unison.Prelude
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.Term qualified as Term
import Unison.Type (Type)
import Unison.Type qualified as Type
import Unison.Util.Defns (Defns (..), DefnsF, DefnsF2)
import Unison.Util.Map qualified as Map
import Unison.Var (Var)
import Witch (unsafeFrom)

synhashLcaDefns ::
  (HasCallStack) =>
  (term -> Term Symbol Ann) ->
  PrettyPrintEnv ->
  PartialDeclNameLookup ->
  DefnsF (Map Name) Referent TypeReference ->
  Defns (Map TermReferenceId term) (Map TypeReferenceId (Decl Symbol Ann)) ->
  DefnsF2 (Map Name) Synhashed Referent TypeReference
synhashLcaDefns :: forall term.
HasCallStack =>
(term -> Term Symbol Ann)
-> PrettyPrintEnv
-> PartialDeclNameLookup
-> DefnsF (Map Name) Referent TypeReference
-> Defns
     (Map TermReferenceId term) (Map TermReferenceId (Decl Symbol Ann))
-> DefnsF2 (Map Name) Synhashed Referent TypeReference
synhashLcaDefns term -> Term Symbol Ann
toTerm PrettyPrintEnv
ppe PartialDeclNameLookup
declNameLookup DefnsF (Map Name) Referent TypeReference
defns Defns
  (Map TermReferenceId term) (Map TermReferenceId (Decl Symbol Ann))
hydratedDefns =
  (Name -> Referent -> Hash)
-> (Name -> TypeReference -> Hash)
-> DefnsF (Map Name) Referent TypeReference
-> DefnsF2 (Map Name) Synhashed Referent TypeReference
forall term typ.
HasCallStack =>
(Name -> term -> Hash)
-> (Name -> typ -> Hash)
-> DefnsF (Map Name) term typ
-> DefnsF2 (Map Name) Synhashed term typ
synhashDefnsWith Name -> Referent -> Hash
hashReferent Name -> TypeReference -> Hash
hashType DefnsF (Map Name) Referent TypeReference
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 TypeReference
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 -> TypeReference -> Hash
hashType Name
declName TypeReference
ref
      Referent.Ref TypeReference
ref -> (term -> Term Symbol Ann)
-> PrettyPrintEnv
-> Map TermReferenceId term
-> TypeReference
-> Hash
forall term.
HasCallStack =>
(term -> Term Symbol Ann)
-> PrettyPrintEnv
-> Map TermReferenceId term
-> TypeReference
-> Hash
synhashTermReference term -> Term Symbol Ann
toTerm PrettyPrintEnv
ppe Defns
  (Map TermReferenceId term) (Map TermReferenceId (Decl Symbol Ann))
hydratedDefns.terms TypeReference
ref

    hashType :: Name -> TypeReference -> Hash
    hashType :: Name -> TypeReference -> Hash
hashType Name
name = \case
      ReferenceBuiltin Text
builtin -> Text -> Hash
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 (Name -> Map Name [Maybe Name] -> [Maybe Name]
forall k v. (Ord k, Show k) => k -> Map k v -> v
Map.lookupJust Name
name PartialDeclNameLookup
declNameLookup.declToConstructors) 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
setConstructorNamesAndSynhashDerivedDecl PrettyPrintEnv
ppe Defns
  (Map TermReferenceId term) (Map TermReferenceId (Decl Symbol Ann))
hydratedDefns.types [Name]
names Name
name TermReferenceId
ref

-- | Computes syntactic hashes of non-LCA definitions.
synhashDefns ::
  (HasCallStack) =>
  (term -> Term Symbol Ann) ->
  PrettyPrintEnv ->
  Defns (Map TermReferenceId term) (Map TypeReferenceId (Decl Symbol Ann)) ->
  DeclNameLookup ->
  DefnsF (Map Name) Referent TypeReference ->
  DefnsF2 (Map Name) Synhashed Referent TypeReference
synhashDefns :: forall term.
HasCallStack =>
(term -> Term Symbol Ann)
-> PrettyPrintEnv
-> Defns
     (Map TermReferenceId term) (Map TermReferenceId (Decl Symbol Ann))
-> DeclNameLookup
-> DefnsF (Map Name) Referent TypeReference
-> DefnsF2 (Map Name) Synhashed Referent TypeReference
synhashDefns term -> Term Symbol Ann
toTerm PrettyPrintEnv
ppe Defns
  (Map TermReferenceId term) (Map TermReferenceId (Decl Symbol Ann))
hydratedDefns DeclNameLookup
declNameLookup =
  (Name -> Referent -> Hash)
-> (Name -> TypeReference -> Hash)
-> DefnsF (Map Name) Referent TypeReference
-> DefnsF2 (Map Name) Synhashed Referent TypeReference
forall term typ.
HasCallStack =>
(Name -> term -> Hash)
-> (Name -> typ -> Hash)
-> DefnsF (Map Name) term typ
-> DefnsF2 (Map Name) Synhashed term typ
synhashDefnsWith Name -> Referent -> Hash
hashReferent Name -> TypeReference -> 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 TypeReference
ref ConstructorId
_) ConstructorType
_ -> Name -> TypeReference -> Hash
hashType (HasCallStack => DeclNameLookup -> Name -> Name
DeclNameLookup -> Name -> Name
DeclNameLookup.expectDeclName DeclNameLookup
declNameLookup Name
name) TypeReference
ref
      Referent.Ref TypeReference
ref -> (term -> Term Symbol Ann)
-> PrettyPrintEnv
-> Map TermReferenceId term
-> TypeReference
-> Hash
forall term.
HasCallStack =>
(term -> Term Symbol Ann)
-> PrettyPrintEnv
-> Map TermReferenceId term
-> TypeReference
-> Hash
synhashTermReference term -> Term Symbol Ann
toTerm PrettyPrintEnv
ppe Defns
  (Map TermReferenceId term) (Map TermReferenceId (Decl Symbol Ann))
hydratedDefns.terms TypeReference
ref

    hashType :: Name -> TypeReference -> Hash
    hashType :: Name -> TypeReference -> Hash
hashType Name
name = \case
      ReferenceBuiltin Text
builtin -> Text -> Hash
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
setConstructorNamesAndSynhashDerivedDecl
          PrettyPrintEnv
ppe
          Defns
  (Map TermReferenceId term) (Map TermReferenceId (Decl Symbol Ann))
hydratedDefns.types
          (HasCallStack => DeclNameLookup -> Name -> [Name]
DeclNameLookup -> Name -> [Name]
DeclNameLookup.expectConstructorNames DeclNameLookup
declNameLookup Name
name)
          Name
name
          TermReferenceId
ref

synhashDefnsWith ::
  (HasCallStack) =>
  (Name -> term -> Hash) ->
  (Name -> typ -> Hash) ->
  DefnsF (Map Name) term typ ->
  DefnsF2 (Map Name) Synhashed term typ
synhashDefnsWith :: forall term typ.
HasCallStack =>
(Name -> term -> Hash)
-> (Name -> typ -> Hash)
-> DefnsF (Map Name) term typ
-> DefnsF2 (Map Name) Synhashed term typ
synhashDefnsWith Name -> term -> Hash
hashTerm Name -> typ -> Hash
hashType = do
  (Map Name term -> Map Name (Synhashed term))
-> (Map Name typ -> Map Name (Synhashed typ))
-> DefnsF (Map Name) term typ
-> 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) ((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)
  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

synhashTermReference ::
  (HasCallStack) =>
  (term -> Term Symbol Ann) ->
  PrettyPrintEnv ->
  Map TermReferenceId term ->
  TermReference ->
  Hash
synhashTermReference :: forall term.
HasCallStack =>
(term -> Term Symbol Ann)
-> PrettyPrintEnv
-> Map TermReferenceId term
-> TypeReference
-> Hash
synhashTermReference term -> Term Symbol Ann
toTerm PrettyPrintEnv
ppe Map TermReferenceId term
termsById = \case
  ReferenceBuiltin Text
builtin -> Text -> Hash
synhashBuiltinTerm Text
builtin
  ReferenceDerived TermReferenceId
ref -> PrettyPrintEnv -> Term Symbol Ann -> Hash
forall v a. Var v => PrettyPrintEnv -> Term v a -> Hash
synhashDerivedTerm PrettyPrintEnv
ppe (term -> Term Symbol Ann
toTerm (TermReferenceId -> Map TermReferenceId term -> term
forall k v. (Ord k, Show k) => k -> Map k v -> v
Map.lookupJust TermReferenceId
ref Map TermReferenceId term
termsById))

setConstructorNamesAndSynhashDerivedDecl ::
  (HasCallStack) =>
  PrettyPrintEnv ->
  Map TypeReferenceId (Decl Symbol Ann) ->
  [Name] ->
  Name ->
  TypeReferenceId ->
  Hash
setConstructorNamesAndSynhashDerivedDecl :: HasCallStack =>
PrettyPrintEnv
-> Map TermReferenceId (Decl Symbol Ann)
-> [Name]
-> Name
-> TermReferenceId
-> Hash
setConstructorNamesAndSynhashDerivedDecl 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
& TermReferenceId
-> Map TermReferenceId (Decl Symbol Ann) -> Decl Symbol Ann
forall k v. (Ord k, Show k) => k -> Map k v -> v
Map.lookupJust 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
synhashDerivedDecl PrettyPrintEnv
ppe Name
name

type Token = H.Token Hash

-- A few tags for readability

isBuiltinTag, isNotBuiltinTag :: H.Token Hash
isBuiltinTag :: Token
isBuiltinTag = Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
0
isNotBuiltinTag :: Token
isNotBuiltinTag = Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
1

isDeclTag, isTermTag :: H.Token Hash
isDeclTag :: Token
isDeclTag = Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
0
isTermTag :: Token
isTermTag = Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
1

synhashBuiltinDecl :: Text -> Hash
synhashBuiltinDecl :: Text -> Hash
synhashBuiltinDecl Text
name =
  [Token] -> Hash
forall h. Accumulate h => [Token h] -> h
H.accumulate [Token
isBuiltinTag, Token
isDeclTag, Text -> Token
forall h. Text -> Token h
H.Text Text
name]

synhashBuiltinTerm :: Text -> Hash
synhashBuiltinTerm :: Text -> Hash
synhashBuiltinTerm =
  [Token] -> Hash
forall h. Accumulate h => [Token h] -> h
H.accumulate ([Token] -> Hash) -> (Text -> [Token]) -> Text -> Hash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Token]
hashBuiltinTermTokens

hashBuiltinTermTokens :: Text -> [Token]
hashBuiltinTermTokens :: Text -> [Token]
hashBuiltinTermTokens Text
name =
  [Token
isBuiltinTag, Token
isTermTag, Text -> Token
forall h. Text -> Token h
H.Text Text
name]

hashCaseTokens :: PrettyPrintEnv -> Term.MatchCase loc a -> [Token]
hashCaseTokens :: forall loc a. PrettyPrintEnv -> MatchCase loc a -> [Token]
hashCaseTokens PrettyPrintEnv
ppe (Term.MatchCase Pattern loc
pat Maybe a
Nothing a
_) = Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
0 Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: PrettyPrintEnv -> Pattern loc -> [Token]
forall loc. PrettyPrintEnv -> Pattern loc -> [Token]
hashPatternTokens PrettyPrintEnv
ppe Pattern loc
pat
hashCaseTokens PrettyPrintEnv
ppe (Term.MatchCase Pattern loc
pat (Just a
_) a
_) = Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
1 Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: PrettyPrintEnv -> Pattern loc -> [Token]
forall loc. PrettyPrintEnv -> Pattern loc -> [Token]
hashPatternTokens PrettyPrintEnv
ppe Pattern loc
pat

-- | The hash of a constructor name determined by how it looks when rendered, i.e. without the decl name prefix.
--
-- For example, in the decl "Maybe" with constructors "Maybe.Just" and "Maybe.Nothing", the hash of constructor
-- "Maybe.Nothing" is hash of the string "Nothing".
hashConstructorNameToken :: Name -> Name -> Token
hashConstructorNameToken :: Name -> Name -> Token
hashConstructorNameToken Name
declName Name
conName =
  let strippedConName :: Name
strippedConName =
        Name -> Name -> Maybe Name
Name.stripNamePrefix Name
declName Name
conName
          Maybe Name -> (Maybe Name -> Name) -> Name
forall a b. a -> (a -> b) -> b
& Name -> Maybe Name -> Name
forall a. a -> Maybe a -> a
fromMaybe
            ( [Char] -> Name
forall a. HasCallStack => [Char] -> a
error ([Char] -> Name) -> [Char] -> Name
forall a b. (a -> b) -> a -> b
$
                [Char] -> [Char] -> [Char]
reportBug
                  [Char]
"E784201"
                  ( [Char]
"constructor "
                      [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
Text.unpack (Name -> Text
Name.toText Name
conName)
                      [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not under decl "
                      [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
Text.unpack (Name -> Text
Name.toText Name
declName)
                  )
            )
   in Text -> Token
forall h. Text -> Token h
H.Text (Name -> Text
Name.toText Name
strippedConName)

synhashDerivedTerm :: (Var v) => PrettyPrintEnv -> Term v a -> Hash
synhashDerivedTerm :: forall v a. Var v => PrettyPrintEnv -> Term v a -> Hash
synhashDerivedTerm PrettyPrintEnv
ppe Term v a
term =
  [Token] -> Hash
forall h. Accumulate h => [Token h] -> h
H.accumulate (PrettyPrintEnv -> Term v a -> [Token]
forall a v. Var v => PrettyPrintEnv -> Term v a -> [Token]
hashDerivedTermTokens PrettyPrintEnv
ppe Term v a
term)

hashDerivedTermTokens :: forall a v. (Var v) => PrettyPrintEnv -> Term v a -> [Token]
hashDerivedTermTokens :: forall a v. Var v => PrettyPrintEnv -> Term v a -> [Token]
hashDerivedTermTokens PrettyPrintEnv
ppe =
  (Token
isNotBuiltinTag Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:) ([Token] -> [Token])
-> (Term v a -> [Token]) -> Term v a -> [Token]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Token
isTermTag Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:) ([Token] -> [Token])
-> (Term v a -> [Token]) -> Term v a -> [Token]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v] -> Term v a -> [Token]
go []
  where
    go :: [v] -> Term v a -> [Token]
    go :: [v] -> Term v a -> [Token]
go [v]
bound Term v a
t =
      Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
255 Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: case Term v a -> ABT (F v a a) v (Term v a)
forall (f :: * -> *) v a. Term f v a -> ABT f v (Term f v a)
ABT.out Term v a
t of
        ABT.Var v
v -> [Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
0, [v] -> v -> Token
forall v. Var v => [v] -> v -> Token
hashVarToken [v]
bound v
v]
        -- trick: encode the structure, followed the children as a flat list
        ABT.Tm F v a a (Term v a)
f -> Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
1 Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: PrettyPrintEnv -> F v a a () -> [Token]
forall v a. Var v => PrettyPrintEnv -> F v a a () -> [Token]
hashTermFTokens PrettyPrintEnv
ppe (F v a a (Term v a) -> F v a a ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void F v a a (Term v a)
f) [Token] -> [Token] -> [Token]
forall a. Semigroup a => a -> a -> a
<> (F v a a (Term v a) -> [Term v a]
forall a. F v a a a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList F v a a (Term v a)
f [Term v a] -> (Term v a -> [Token]) -> [Token]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [v] -> Term v a -> [Token]
go [v]
bound)
        ABT.Cycle Term v a
c -> Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
2 Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [v] -> Term v a -> [Token]
go [v]
bound Term v a
c
        ABT.Abs v
v Term v a
body -> Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
3 Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [v] -> Term v a -> [Token]
go (v
v v -> [v] -> [v]
forall a. a -> [a] -> [a]
: [v]
bound) Term v a
body

hashConstructorType :: ConstructorType -> Token
hashConstructorType :: ConstructorType -> Token
hashConstructorType = \case
  ConstructorType
CT.Effect -> Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
0
  ConstructorType
CT.Data -> Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
1

hashDataDeclTokens :: (Var v) => PrettyPrintEnv -> Name -> DataDeclaration v a -> [Token]
hashDataDeclTokens :: forall v a.
Var v =>
PrettyPrintEnv -> Name -> DataDeclaration v a -> [Token]
hashDataDeclTokens PrettyPrintEnv
ppe Name
declName (DD.DataDeclaration Modifier
modifier a
_ [v]
bound [(a, v, Type v a)]
ctors) =
  Modifier -> [Token]
hashModifierTokens Modifier
modifier [Token] -> [Token] -> [Token]
forall a. Semigroup a => a -> a -> a
<> ([(a, v, Type v a)]
ctors [(a, v, Type v a)] -> ((a, v, Type v a) -> [Token]) -> [Token]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PrettyPrintEnv -> Name -> [v] -> (a, v, Type v a) -> [Token]
forall v a.
Var v =>
PrettyPrintEnv -> Name -> [v] -> (a, v, Type v a) -> [Token]
hashConstructorTokens PrettyPrintEnv
ppe Name
declName [v]
bound)

-- separating constructor types with tag of 99, which isn't used elsewhere
hashConstructorTokens :: (Var v) => PrettyPrintEnv -> Name -> [v] -> (a, v, Type v a) -> [Token]
hashConstructorTokens :: forall v a.
Var v =>
PrettyPrintEnv -> Name -> [v] -> (a, v, Type v a) -> [Token]
hashConstructorTokens PrettyPrintEnv
ppe Name
declName [v]
bound (a
_, v
conName, Type v a
ty) =
  Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
99
    Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: Name -> Name -> Token
hashConstructorNameToken Name
declName (v -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar v
conName)
    Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: PrettyPrintEnv -> [v] -> Type v a -> [Token]
forall v a. Var v => PrettyPrintEnv -> [v] -> Type v a -> [Token]
hashTypeTokens PrettyPrintEnv
ppe [v]
bound Type v a
ty

hashDeclTokens :: (Var v) => PrettyPrintEnv -> Name -> Decl v a -> [Token]
hashDeclTokens :: forall v a. Var v => PrettyPrintEnv -> Name -> Decl v a -> [Token]
hashDeclTokens PrettyPrintEnv
ppe Name
name Decl v a
decl =
  ConstructorType -> Token
hashConstructorType (Decl v a -> ConstructorType
forall v a. Decl v a -> ConstructorType
DD.constructorType Decl v a
decl) Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: PrettyPrintEnv -> Name -> DataDeclaration v a -> [Token]
forall v a.
Var v =>
PrettyPrintEnv -> Name -> DataDeclaration v a -> [Token]
hashDataDeclTokens PrettyPrintEnv
ppe Name
name (Decl v a -> DataDeclaration v a
forall v a. Decl v a -> DataDeclaration v a
DD.asDataDecl Decl v a
decl)

-- | Syntactically hash a decl, using reference names rather than hashes. Two decls will have the same syntactic hash if
-- they they are the same sort of decl (both are data decls or both are effect decls), the unique type guid is the same,
-- the constructors appear in the same order and have the same names, and the constructors' types have the same
-- syntactic hashes.
synhashDerivedDecl :: (Var v) => PrettyPrintEnv -> Name -> Decl v a -> Hash
synhashDerivedDecl :: forall v a. Var v => PrettyPrintEnv -> Name -> Decl v a -> Hash
synhashDerivedDecl PrettyPrintEnv
ppe Name
name Decl v a
decl =
  [Token] -> Hash
forall h. Accumulate h => [Token h] -> h
H.accumulate ([Token] -> Hash) -> [Token] -> Hash
forall a b. (a -> b) -> a -> b
$ Token
isNotBuiltinTag Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: Token
isDeclTag Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: PrettyPrintEnv -> Name -> Decl v a -> [Token]
forall v a. Var v => PrettyPrintEnv -> Name -> Decl v a -> [Token]
hashDeclTokens PrettyPrintEnv
ppe Name
name Decl v a
decl

hashHQNameToken :: HashQualified Name -> Token
hashHQNameToken :: HashQualified Name -> Token
hashHQNameToken =
  Text -> Token
forall h. Text -> Token h
H.Text (Text -> Token)
-> (HashQualified Name -> Text) -> HashQualified Name -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Text) -> HashQualified Name -> Text
forall n. (n -> Text) -> HashQualified n -> Text
HQ.toTextWith Name -> Text
Name.toText

hashKindTokens :: K.Kind -> [Token]
hashKindTokens :: Kind -> [Token]
hashKindTokens Kind
k = case Kind
k of
  Kind
K.Star -> [Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
0]
  K.Arrow Kind
k1 Kind
k2 -> Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
1 Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: (Kind -> [Token]
hashKindTokens Kind
k1 [Token] -> [Token] -> [Token]
forall a. Semigroup a => a -> a -> a
<> Kind -> [Token]
hashKindTokens Kind
k2)

hashLengthToken :: (Foldable t) => t a -> Token
hashLengthToken :: forall (t :: * -> *) a. Foldable t => t a -> Token
hashLengthToken =
  ConstructorId -> Token
forall h. ConstructorId -> Token h
H.Nat (ConstructorId -> Token) -> (t a -> ConstructorId) -> t a -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Word64 (Int -> ConstructorId) -> (t a -> Int) -> t a -> ConstructorId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> Int
forall a. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length

hashModifierTokens :: DD.Modifier -> [Token]
hashModifierTokens :: Modifier -> [Token]
hashModifierTokens = \case
  Modifier
DD.Structural -> [Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
0]
  DD.Unique Text
txt -> [Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
1, Text -> Token
forall h. Text -> Token h
H.Text Text
txt]

hashPatternTokens :: PrettyPrintEnv -> Pattern.Pattern loc -> [Token]
hashPatternTokens :: forall loc. PrettyPrintEnv -> Pattern loc -> [Token]
hashPatternTokens PrettyPrintEnv
ppe = \case
  Pattern.Unbound {} -> [Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
0]
  Pattern.Var {} -> [Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
1]
  Pattern.Boolean loc
_ Bool
b -> [Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
2, if Bool
b then Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
0 else Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
1]
  Pattern.Int loc
_ Int64
n -> [Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
3, Int64 -> Token
forall h. Int64 -> Token h
H.Int Int64
n]
  Pattern.Nat loc
_ ConstructorId
n -> [Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
4, ConstructorId -> Token
forall h. ConstructorId -> Token h
H.Nat ConstructorId
n]
  Pattern.Float loc
_ Double
f -> [Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
5, Double -> Token
forall h. Double -> Token h
H.Double Double
f]
  Pattern.Text loc
_ Text
t -> [Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
6, Text -> Token
forall h. Text -> Token h
H.Text Text
t]
  Pattern.Char loc
_ Char
c -> [Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
7, ConstructorId -> Token
forall h. ConstructorId -> Token h
H.Nat (Int -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
c))]
  Pattern.Constructor loc
_ GConstructorReference TypeReference
cr [Pattern loc]
ps ->
    Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
8
      Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: PrettyPrintEnv -> Referent -> Token
hashReferentToken PrettyPrintEnv
ppe (GConstructorReference TypeReference -> ConstructorType -> Referent
Referent.Con GConstructorReference TypeReference
cr ConstructorType
CT.Data)
      Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [Pattern loc] -> Token
forall (t :: * -> *) a. Foldable t => t a -> Token
hashLengthToken [Pattern loc]
ps
      Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: ([Pattern loc]
ps [Pattern loc] -> (Pattern loc -> [Token]) -> [Token]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PrettyPrintEnv -> Pattern loc -> [Token]
forall loc. PrettyPrintEnv -> Pattern loc -> [Token]
hashPatternTokens PrettyPrintEnv
ppe)
  Pattern.As loc
_ Pattern loc
p -> Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
9 Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: PrettyPrintEnv -> Pattern loc -> [Token]
forall loc. PrettyPrintEnv -> Pattern loc -> [Token]
hashPatternTokens PrettyPrintEnv
ppe Pattern loc
p
  Pattern.EffectPure loc
_ Pattern loc
p -> Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
10 Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: PrettyPrintEnv -> Pattern loc -> [Token]
forall loc. PrettyPrintEnv -> Pattern loc -> [Token]
hashPatternTokens PrettyPrintEnv
ppe Pattern loc
p
  Pattern.EffectBind loc
_ GConstructorReference TypeReference
cr [Pattern loc]
ps Pattern loc
k ->
    Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
11
      Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: PrettyPrintEnv -> Referent -> Token
hashReferentToken PrettyPrintEnv
ppe (GConstructorReference TypeReference -> ConstructorType -> Referent
Referent.Con GConstructorReference TypeReference
cr ConstructorType
CT.Effect)
      Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [Pattern loc] -> Token
forall (t :: * -> *) a. Foldable t => t a -> Token
hashLengthToken [Pattern loc]
ps
      Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: PrettyPrintEnv -> Pattern loc -> [Token]
forall loc. PrettyPrintEnv -> Pattern loc -> [Token]
hashPatternTokens PrettyPrintEnv
ppe Pattern loc
k [Token] -> [Token] -> [Token]
forall a. Semigroup a => a -> a -> a
<> ([Pattern loc]
ps [Pattern loc] -> (Pattern loc -> [Token]) -> [Token]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PrettyPrintEnv -> Pattern loc -> [Token]
forall loc. PrettyPrintEnv -> Pattern loc -> [Token]
hashPatternTokens PrettyPrintEnv
ppe)
  Pattern.SequenceLiteral loc
_ [Pattern loc]
ps -> Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
12 Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [Pattern loc] -> Token
forall (t :: * -> *) a. Foldable t => t a -> Token
hashLengthToken [Pattern loc]
ps Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: ([Pattern loc]
ps [Pattern loc] -> (Pattern loc -> [Token]) -> [Token]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PrettyPrintEnv -> Pattern loc -> [Token]
forall loc. PrettyPrintEnv -> Pattern loc -> [Token]
hashPatternTokens PrettyPrintEnv
ppe)
  Pattern.SequenceOp loc
_ Pattern loc
p SeqOp
op Pattern loc
q -> Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
16 Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: SeqOp -> Token
forall {h}. SeqOp -> Token h
top SeqOp
op Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: PrettyPrintEnv -> Pattern loc -> [Token]
forall loc. PrettyPrintEnv -> Pattern loc -> [Token]
hashPatternTokens PrettyPrintEnv
ppe Pattern loc
p [Token] -> [Token] -> [Token]
forall a. Semigroup a => a -> a -> a
<> PrettyPrintEnv -> Pattern loc -> [Token]
forall loc. PrettyPrintEnv -> Pattern loc -> [Token]
hashPatternTokens PrettyPrintEnv
ppe Pattern loc
q
    where
      top :: SeqOp -> Token h
top = \case
        SeqOp
Pattern.Concat -> Word8 -> Token h
forall h. Word8 -> Token h
H.Tag Word8
0
        SeqOp
Pattern.Snoc -> Word8 -> Token h
forall h. Word8 -> Token h
H.Tag Word8
1
        SeqOp
Pattern.Cons -> Word8 -> Token h
forall h. Word8 -> Token h
H.Tag Word8
2

hashReferentToken :: PrettyPrintEnv -> Referent -> Token
hashReferentToken :: PrettyPrintEnv -> Referent -> Token
hashReferentToken PrettyPrintEnv
ppe =
  HashQualified Name -> Token
hashHQNameToken (HashQualified Name -> Token)
-> (Referent -> HashQualified Name) -> Referent -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyPrintEnv -> Referent -> HashQualified Name
PPE.termNameOrHashOnlyFq PrettyPrintEnv
ppe

hashTermFTokens :: (Var v) => PrettyPrintEnv -> Term.F v a a () -> [Token]
hashTermFTokens :: forall v a. Var v => PrettyPrintEnv -> F v a a () -> [Token]
hashTermFTokens PrettyPrintEnv
ppe = \case
  Term.Int Int64
n -> [Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
0, Int64 -> Token
forall h. Int64 -> Token h
H.Int Int64
n]
  Term.Nat ConstructorId
n -> [Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
1, ConstructorId -> Token
forall h. ConstructorId -> Token h
H.Nat ConstructorId
n]
  Term.Float Double
n -> [Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
2, Double -> Token
forall h. Double -> Token h
H.Double Double
n]
  Term.Boolean Bool
b -> [Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
3, if Bool
b then Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
0 else Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
1]
  Term.Text Text
t -> [Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
4, Text -> Token
forall h. Text -> Token h
H.Text Text
t]
  Term.Char Char
c -> [Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
5, ConstructorId -> Token
forall h. ConstructorId -> Token h
H.Nat (Int -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
c))]
  Term.Blank {} -> [Char] -> [Token]
forall a. HasCallStack => [Char] -> a
error [Char]
"tried to hash a term with blanks, something's very wrong"
  -- note: these are all hashed the same, just based on the name
  Term.Ref TypeReference
r -> [Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
7, PrettyPrintEnv -> Referent -> Token
hashReferentToken PrettyPrintEnv
ppe (TypeReference -> Referent
Referent.Ref TypeReference
r)]
  Term.Constructor GConstructorReference TypeReference
cr -> [Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
7, PrettyPrintEnv -> Referent -> Token
hashReferentToken PrettyPrintEnv
ppe (GConstructorReference TypeReference -> ConstructorType -> Referent
Referent.Con GConstructorReference TypeReference
cr ConstructorType
CT.Data)]
  Term.Request GConstructorReference TypeReference
cr -> [Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
7, PrettyPrintEnv -> Referent -> Token
hashReferentToken PrettyPrintEnv
ppe (GConstructorReference TypeReference -> ConstructorType -> Referent
Referent.Con GConstructorReference TypeReference
cr ConstructorType
CT.Effect)]
  Term.Handle {} -> [Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
8]
  Term.App {} -> [Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
9]
  Term.Ann ()
_ Type v a
ty -> Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
10 Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: PrettyPrintEnv -> [v] -> Type v a -> [Token]
forall v a. Var v => PrettyPrintEnv -> [v] -> Type v a -> [Token]
hashTypeTokens PrettyPrintEnv
ppe [] Type v a
ty
  Term.List Seq ()
xs -> [Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
11, Seq () -> Token
forall (t :: * -> *) a. Foldable t => t a -> Token
hashLengthToken Seq ()
xs]
  Term.If {} -> [Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
12]
  Term.And {} -> [Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
13]
  Term.Or {} -> [Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
14]
  Term.Lam {} -> [Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
15]
  Term.LetRec Bool
_ [()]
bs ()
_ -> [Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
16, [()] -> Token
forall (t :: * -> *) a. Foldable t => t a -> Token
hashLengthToken [()]
bs]
  Term.Let {} -> [Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
17]
  Term.Match ()
_scrute [MatchCase a ()]
cases ->
    Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
18 Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [MatchCase a ()] -> Token
forall (t :: * -> *) a. Foldable t => t a -> Token
hashLengthToken [MatchCase a ()]
cases Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: ([MatchCase a ()]
cases [MatchCase a ()] -> (MatchCase a () -> [Token]) -> [Token]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PrettyPrintEnv -> MatchCase a () -> [Token]
forall loc a. PrettyPrintEnv -> MatchCase loc a -> [Token]
hashCaseTokens PrettyPrintEnv
ppe)
  Term.TermLink Referent
rf -> [Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
19, PrettyPrintEnv -> Referent -> Token
hashReferentToken PrettyPrintEnv
ppe Referent
rf]
  Term.TypeLink TypeReference
r -> [Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
20, PrettyPrintEnv -> TypeReference -> Token
hashTypeReferenceToken PrettyPrintEnv
ppe TypeReference
r]

hashTypeTokens :: forall v a. (Var v) => PrettyPrintEnv -> [v] -> Type v a -> [Token]
hashTypeTokens :: forall v a. Var v => PrettyPrintEnv -> [v] -> Type v a -> [Token]
hashTypeTokens PrettyPrintEnv
ppe = [v] -> Type v a -> [Token]
go
  where
    go :: [v] -> Type v a -> [Token]
    go :: [v] -> Type v a -> [Token]
go [v]
bound Type v a
t =
      Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
254 Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: case Type v a -> ABT F v (Type v a)
forall (f :: * -> *) v a. Term f v a -> ABT f v (Term f v a)
ABT.out Type v a
t of
        ABT.Var v
v -> [Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
0, [v] -> v -> Token
forall v. Var v => [v] -> v -> Token
hashVarToken [v]
bound v
v]
        -- trick: encode the structure, followed the children as a flat list
        ABT.Tm F (Type v a)
f -> Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
1 Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: (PrettyPrintEnv -> F () -> [Token]
hashTypeFTokens PrettyPrintEnv
ppe (F (Type v a) -> F ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void F (Type v a)
f) [Token] -> [Token] -> [Token]
forall a. Semigroup a => a -> a -> a
<> (F (Type v a) -> [Type v a]
forall a. F a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList F (Type v a)
f [Type v a] -> (Type v a -> [Token]) -> [Token]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [v] -> Type v a -> [Token]
go [v]
bound))
        ABT.Cycle Type v a
c -> Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
2 Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [v] -> Type v a -> [Token]
go [v]
bound Type v a
c
        ABT.Abs v
v Type v a
body -> Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
3 Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [v] -> Type v a -> [Token]
go (v
v v -> [v] -> [v]
forall a. a -> [a] -> [a]
: [v]
bound) Type v a
body

hashTypeFTokens :: PrettyPrintEnv -> Type.F () -> [Token]
hashTypeFTokens :: PrettyPrintEnv -> F () -> [Token]
hashTypeFTokens PrettyPrintEnv
ppe = \case
  Type.Ref TypeReference
r -> [Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
0, PrettyPrintEnv -> TypeReference -> Token
hashTypeReferenceToken PrettyPrintEnv
ppe TypeReference
r]
  Type.Arrow {} -> [Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
1]
  Type.Ann ()
_ Kind
k -> Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
2 Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: Kind -> [Token]
hashKindTokens Kind
k
  Type.App {} -> [Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
3]
  Type.Effect {} -> [Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
4]
  Type.Effects [()]
es -> [Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
5, [()] -> Token
forall (t :: * -> *) a. Foldable t => t a -> Token
hashLengthToken [()]
es]
  Type.Forall {} -> [Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
6]
  Type.IntroOuter {} -> [Word8 -> Token
forall h. Word8 -> Token h
H.Tag Word8
7]

hashTypeReferenceToken :: PrettyPrintEnv -> TypeReference -> Token
hashTypeReferenceToken :: PrettyPrintEnv -> TypeReference -> Token
hashTypeReferenceToken PrettyPrintEnv
ppe =
  HashQualified Name -> Token
hashHQNameToken (HashQualified Name -> Token)
-> (TypeReference -> HashQualified Name) -> TypeReference -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyPrintEnv -> TypeReference -> HashQualified Name
PPE.typeNameOrHashOnlyFq PrettyPrintEnv
ppe

hashVarToken :: (Var v) => [v] -> v -> Token
hashVarToken :: forall v. Var v => [v] -> v -> Token
hashVarToken [v]
bound v
v =
  case v -> [v] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
List.elemIndex v
v [v]
bound of
    Maybe Int
Nothing -> [Char] -> Token
forall a. HasCallStack => [Char] -> a
error ([Char] -> [Char] -> [Char]
reportBug [Char]
"E633940" ([Char]
"var " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ v -> [Char]
forall a. Show a => a -> [Char]
show v
v [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not bound in " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [v] -> [Char]
forall a. Show a => a -> [Char]
show [v]
bound))
    Just Int
index -> ConstructorId -> Token
forall h. ConstructorId -> Token h
H.Nat (forall source target.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeFrom @Int @Word64 Int
index)