-- | Description: Converts V1 types to the V2 hashing types
module Unison.Hashing.V2.Convert
  ( ResolutionResult,
    hashBranch0,
    hashCausal,
    hashDataDecls,
    hashDecls,
    hashPatch,
    hashClosedTerm,
    hashTermComponents,
    hashTermComponentsWithoutTypes,
    typeToReference,
    typeToReferenceMentions,
  )
where

import Control.Applicative
import Control.Lens (_3)
import Control.Lens qualified as Lens
import Control.Monad.Trans.Writer.CPS (Writer)
import Control.Monad.Trans.Writer.CPS qualified as Writer
import Data.Map qualified as Map
import Data.Set qualified as Set
import U.Codebase.HashTags (CausalHash (..), PatchHash (..))
import Unison.ABT qualified as ABT
import Unison.Codebase.Branch.Type qualified as Memory.Branch
import Unison.Codebase.Patch qualified as Memory.Patch
import Unison.Codebase.TermEdit qualified as Memory.TermEdit
import Unison.Codebase.TypeEdit qualified as Memory.TypeEdit
import Unison.ConstructorReference qualified as Memory.ConstructorReference
import Unison.ConstructorType qualified as CT
import Unison.ConstructorType qualified as Memory.ConstructorType
import Unison.DataDeclaration qualified as Memory.DD
import Unison.Hash (Hash, HashFor (HashFor))
import Unison.Hashing.V2 qualified as Hashing
import Unison.Kind qualified as Memory.Kind
import Unison.NameSegment qualified as Memory (NameSegment)
import Unison.NameSegment.Internal qualified as Memory.NameSegment
import Unison.Names.ResolutionResult (ResolutionResult)
import Unison.Pattern qualified as Memory.Pattern
import Unison.Prelude
import Unison.Reference qualified as Memory.Reference
import Unison.Referent qualified as Memory.Referent
import Unison.Syntax.Name qualified as Name (unsafeParseVar)
import Unison.Term qualified as Memory.Term
import Unison.Type qualified as Memory.Type
import Unison.Util.Map qualified as Map
import Unison.Util.Relation qualified as Relation
import Unison.Util.Star2 qualified as Memory.Star2
import Unison.Var (Var)

typeToReference :: (Var v) => Memory.Type.Type v a -> Memory.Reference.Reference
typeToReference :: forall v a. Var v => Type v a -> Reference
typeToReference = Reference -> Reference
h2mReference (Reference -> Reference)
-> (Type v a -> Reference) -> Type v a -> Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type v a -> Reference
forall v a. (Ord v, Show v) => Type v a -> Reference
Hashing.typeToReference (Type v a -> Reference)
-> (Type v a -> Type v a) -> Type v a -> Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type v a -> Type v a
forall v a. Ord v => Type v a -> Type v a
m2hType (Type v a -> Type v a)
-> (Type v a -> Type v a) -> Type v a -> Type v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type v a -> Type v a
forall v a. Var v => Type v a -> Type v a
Memory.Type.removeAllEffectVars

typeToReferenceMentions :: (Var v) => Memory.Type.Type v a -> Set Memory.Reference.Reference
typeToReferenceMentions :: forall v a. Var v => Type v a -> Set Reference
typeToReferenceMentions =
  (Reference -> Reference) -> Set Reference -> Set Reference
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Reference -> Reference
h2mReference (Set Reference -> Set Reference)
-> (Type v a -> Set Reference) -> Type v a -> Set Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type v a -> Set Reference
forall v a. (Ord v, Show v) => Type v a -> Set Reference
Hashing.typeToReferenceMentions (Type v a -> Set Reference)
-> (Type v a -> Type v a) -> Type v a -> Set Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type v a -> Type v a
forall v a. Ord v => Type v a -> Type v a
m2hType (Type v a -> Type v a)
-> (Type v a -> Type v a) -> Type v a -> Type v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type v a -> Type v a
forall v a. Var v => Type v a -> Type v a
Memory.Type.removeAllEffectVars

-- TODO: remove non-prime version
-- include type in hash
hashTermComponents ::
  forall v a extra.
  (Var v) =>
  Map v (Memory.Term.Term v a, Memory.Type.Type v a, extra) ->
  Map v (Memory.Reference.TermReferenceId, Memory.Term.Term v a, Memory.Type.Type v a, extra)
hashTermComponents :: forall v a extra.
Var v =>
Map v (Term v a, Type v a, extra)
-> Map v (TermReferenceId, Term v a, Type v a, extra)
hashTermComponents Map v (Term v a, Type v a, extra)
mTerms =
  case Map v (Term v a, Type v a, extra)
-> (Map v (Term v a, Type v a, extra),
    Map Reference ConstructorType)
forall {t :: * -> *} {v} {v} {a} {a} {c}.
(Traversable t, Ord v, Ord v) =>
t (Term v a, Type v a, c)
-> (t (Term v a, Type v a, c), Map Reference ConstructorType)
h2mTermMap Map v (Term v a, Type v a, extra)
mTerms of
    (Map v (Term v a, Type v a, extra)
hTerms, Map Reference ConstructorType
constructorTypes) -> Ord v =>
(Reference -> ConstructorType)
-> (ReferenceId, Term v a, Type v a, extra)
-> (TermReferenceId, Term v a, Type v a, extra)
(Reference -> ConstructorType)
-> (ReferenceId, Term v a, Type v a, extra)
-> (TermReferenceId, Term v a, Type v a, extra)
h2mTermResult (Map Reference ConstructorType
constructorTypes Map Reference ConstructorType -> Reference -> ConstructorType
forall k a. Ord k => Map k a -> k -> a
Map.!) ((ReferenceId, Term v a, Type v a, extra)
 -> (TermReferenceId, Term v a, Type v a, extra))
-> Map v (ReferenceId, Term v a, Type v a, extra)
-> Map v (TermReferenceId, Term v a, Type v a, extra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map v (Term v a, Type v a, extra)
-> Map v (ReferenceId, Term v a, Type v a, extra)
forall v a extra.
Var v =>
Map v (Term v a, Type v a, extra)
-> Map v (ReferenceId, Term v a, Type v a, extra)
Hashing.hashTermComponents Map v (Term v a, Type v a, extra)
hTerms
  where
    h2mTermMap :: t (Term v a, Type v a, c)
-> (t (Term v a, Type v a, c), Map Reference ConstructorType)
h2mTermMap t (Term v a, Type v a, c)
m =
      t (Term v a, Type v a, c)
m
        t (Term v a, Type v a, c)
-> (t (Term v a, Type v a, c)
    -> WriterT
         (Map Reference ConstructorType)
         Identity
         (t (Term v a, Type v a, c)))
-> WriterT
     (Map Reference ConstructorType)
     Identity
     (t (Term v a, Type v a, c))
forall a b. a -> (a -> b) -> b
& ((Term v a, Type v a, c)
 -> WriterT
      (Map Reference ConstructorType) Identity (Term v a, Type v a, c))
-> t (Term v a, Type v a, c)
-> WriterT
     (Map Reference ConstructorType)
     Identity
     (t (Term v a, Type v a, c))
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) -> t a -> f (t b)
traverse (\(Term v a
trm, Type v a
typ, c
extra) -> (Term v a -> Type v a -> c -> (Term v a, Type v a, c))
-> WriterT (Map Reference ConstructorType) Identity (Term v a)
-> WriterT (Map Reference ConstructorType) Identity (Type v a)
-> WriterT (Map Reference ConstructorType) Identity c
-> WriterT
     (Map Reference ConstructorType) Identity (Term v a, Type v a, c)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (,,) (Term v a
-> WriterT (Map Reference ConstructorType) Identity (Term v a)
forall v a.
Ord v =>
Term v a -> Writer (Map Reference ConstructorType) (Term v a)
m2hTerm Term v a
trm) (Type v a
-> WriterT (Map Reference ConstructorType) Identity (Type v a)
forall a. a -> WriterT (Map Reference ConstructorType) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type v a
 -> WriterT (Map Reference ConstructorType) Identity (Type v a))
-> Type v a
-> WriterT (Map Reference ConstructorType) Identity (Type v a)
forall a b. (a -> b) -> a -> b
$ Type v a -> Type v a
forall v a. Ord v => Type v a -> Type v a
m2hType Type v a
typ) (c -> WriterT (Map Reference ConstructorType) Identity c
forall a. a -> WriterT (Map Reference ConstructorType) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure c
extra))
        WriterT
  (Map Reference ConstructorType)
  Identity
  (t (Term v a, Type v a, c))
-> (WriterT
      (Map Reference ConstructorType)
      Identity
      (t (Term v a, Type v a, c))
    -> (t (Term v a, Type v a, c), Map Reference ConstructorType))
-> (t (Term v a, Type v a, c), Map Reference ConstructorType)
forall a b. a -> (a -> b) -> b
& WriterT
  (Map Reference ConstructorType)
  Identity
  (t (Term v a, Type v a, c))
-> (t (Term v a, Type v a, c), Map Reference ConstructorType)
forall w a. Monoid w => Writer w a -> (a, w)
Writer.runWriter
    h2mTermResult ::
      (Ord v) =>
      ( Memory.Reference.Reference ->
        Memory.ConstructorType.ConstructorType
      ) ->
      (Hashing.ReferenceId, Hashing.Term v a, Hashing.Type v a, extra) ->
      (Memory.Reference.TermReferenceId, Memory.Term.Term v a, Memory.Type.Type v a, extra)
    h2mTermResult :: Ord v =>
(Reference -> ConstructorType)
-> (ReferenceId, Term v a, Type v a, extra)
-> (TermReferenceId, Term v a, Type v a, extra)
h2mTermResult Reference -> ConstructorType
getCtorType (ReferenceId
id, Term v a
tm, Type v a
typ, extra
extra) = (ReferenceId -> TermReferenceId
h2mReferenceId ReferenceId
id, (Reference -> ConstructorType) -> Term v a -> Term v a
forall v a.
Ord v =>
(Reference -> ConstructorType) -> Term v a -> Term v a
h2mTerm Reference -> ConstructorType
getCtorType Term v a
tm, Type v a -> Type v a
forall v a. Ord v => Type v a -> Type v a
h2mType Type v a
typ, extra
extra)

-- | This shouldn't be used when storing terms in the codebase, as it doesn't incorporate the type into the hash.
--   this should only be used in cases where you just need a way to identify some terms that you have, but won't be
--   saving them.
hashTermComponentsWithoutTypes ::
  forall v a.
  (Var v) =>
  Map v (Memory.Term.Term v a) ->
  Map v (Memory.Reference.TermReferenceId, Memory.Term.Term v a)
hashTermComponentsWithoutTypes :: forall v a.
Var v =>
Map v (Term v a) -> Map v (TermReferenceId, Term v a)
hashTermComponentsWithoutTypes Map v (Term v a)
mTerms =
  case Writer (Map Reference ConstructorType) (Map v (Term v a))
-> (Map v (Term v a), Map Reference ConstructorType)
forall w a. Monoid w => Writer w a -> (a, w)
Writer.runWriter ((Term v a
 -> WriterT (Map Reference ConstructorType) Identity (Term v a))
-> Map v (Term v a)
-> Writer (Map Reference ConstructorType) (Map v (Term v a))
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) -> Map v a -> f (Map v b)
traverse Term v a
-> WriterT (Map Reference ConstructorType) Identity (Term v a)
forall v a.
Ord v =>
Term v a -> Writer (Map Reference ConstructorType) (Term v a)
m2hTerm Map v (Term v a)
mTerms) of
    (Map v (Term v a)
hTerms, Map Reference ConstructorType
constructorTypes) -> Ord v =>
(Reference -> ConstructorType)
-> (ReferenceId, Term v a) -> (TermReferenceId, Term v a)
(Reference -> ConstructorType)
-> (ReferenceId, Term v a) -> (TermReferenceId, Term v a)
h2mTermResult (Map Reference ConstructorType
constructorTypes Map Reference ConstructorType -> Reference -> ConstructorType
forall k a. Ord k => Map k a -> k -> a
Map.!) ((ReferenceId, Term v a) -> (TermReferenceId, Term v a))
-> Map v (ReferenceId, Term v a)
-> Map v (TermReferenceId, Term v a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map v (Term v a) -> Map v (ReferenceId, Term v a)
forall v a.
Var v =>
Map v (Term v a) -> Map v (ReferenceId, Term v a)
Hashing.hashTermComponentsWithoutTypes Map v (Term v a)
hTerms
  where
    h2mTermResult ::
      (Ord v) =>
      (Memory.Reference.Reference -> Memory.ConstructorType.ConstructorType) ->
      (Hashing.ReferenceId, Hashing.Term v a) ->
      (Memory.Reference.TermReferenceId, Memory.Term.Term v a)
    h2mTermResult :: Ord v =>
(Reference -> ConstructorType)
-> (ReferenceId, Term v a) -> (TermReferenceId, Term v a)
h2mTermResult Reference -> ConstructorType
getCtorType (ReferenceId
id, Term v a
tm) = (ReferenceId -> TermReferenceId
h2mReferenceId ReferenceId
id, (Reference -> ConstructorType) -> Term v a -> Term v a
forall v a.
Ord v =>
(Reference -> ConstructorType) -> Term v a -> Term v a
h2mTerm Reference -> ConstructorType
getCtorType Term v a
tm)

hashClosedTerm :: (Var v) => Memory.Term.Term v a -> Memory.Reference.Id
hashClosedTerm :: forall v a. Var v => Term v a -> TermReferenceId
hashClosedTerm = ReferenceId -> TermReferenceId
h2mReferenceId (ReferenceId -> TermReferenceId)
-> (Term v a -> ReferenceId) -> Term v a -> TermReferenceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term v a -> ReferenceId
forall v a. Var v => Term v a -> ReferenceId
Hashing.hashClosedTerm (Term v a -> ReferenceId)
-> (Term v a -> Term v a) -> Term v a -> ReferenceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Term v a, Map Reference ConstructorType) -> Term v a
forall a b. (a, b) -> a
fst ((Term v a, Map Reference ConstructorType) -> Term v a)
-> (Term v a -> (Term v a, Map Reference ConstructorType))
-> Term v a
-> Term v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Writer (Map Reference ConstructorType) (Term v a)
-> (Term v a, Map Reference ConstructorType)
forall w a. Monoid w => Writer w a -> (a, w)
Writer.runWriter (Writer (Map Reference ConstructorType) (Term v a)
 -> (Term v a, Map Reference ConstructorType))
-> (Term v a -> Writer (Map Reference ConstructorType) (Term v a))
-> Term v a
-> (Term v a, Map Reference ConstructorType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term v a -> Writer (Map Reference ConstructorType) (Term v a)
forall v a.
Ord v =>
Term v a -> Writer (Map Reference ConstructorType) (Term v a)
m2hTerm

m2hTerm :: (Ord v) => Memory.Term.Term v a -> Writer (Map Memory.Reference.Reference Memory.ConstructorType.ConstructorType) (Hashing.Term v a)
m2hTerm :: forall v a.
Ord v =>
Term v a -> Writer (Map Reference ConstructorType) (Term v a)
m2hTerm = (forall a1.
 F v a a a1
 -> WriterT
      (Map Reference ConstructorType) Identity (TermF v a a a1))
-> Term (F v a a) v a
-> WriterT
     (Map Reference ConstructorType) Identity (Term (TermF v a a) v a)
forall v (m :: * -> *) (g :: * -> *) (f :: * -> *) a.
(Ord v, Monad m, Traversable g) =>
(forall a1. f a1 -> m (g a1)) -> Term f v a -> m (Term g v a)
ABT.transformM \case
  Memory.Term.Int Int64
i -> TermF v a a a1
-> WriterT
     (Map Reference ConstructorType) Identity (TermF v a a a1)
forall a. a -> WriterT (Map Reference ConstructorType) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int64 -> TermF v a a a1
forall typeVar typeAnn patternAnn a.
Int64 -> TermF typeVar typeAnn patternAnn a
Hashing.TermInt Int64
i)
  Memory.Term.Nat Word64
n -> TermF v a a a1
-> WriterT
     (Map Reference ConstructorType) Identity (TermF v a a a1)
forall a. a -> WriterT (Map Reference ConstructorType) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64 -> TermF v a a a1
forall typeVar typeAnn patternAnn a.
Word64 -> TermF typeVar typeAnn patternAnn a
Hashing.TermNat Word64
n)
  Memory.Term.Float Double
d -> TermF v a a a1
-> WriterT
     (Map Reference ConstructorType) Identity (TermF v a a a1)
forall a. a -> WriterT (Map Reference ConstructorType) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> TermF v a a a1
forall typeVar typeAnn patternAnn a.
Double -> TermF typeVar typeAnn patternAnn a
Hashing.TermFloat Double
d)
  Memory.Term.Boolean Bool
b -> TermF v a a a1
-> WriterT
     (Map Reference ConstructorType) Identity (TermF v a a a1)
forall a. a -> WriterT (Map Reference ConstructorType) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> TermF v a a a1
forall typeVar typeAnn patternAnn a.
Bool -> TermF typeVar typeAnn patternAnn a
Hashing.TermBoolean Bool
b)
  Memory.Term.Text Text
t -> TermF v a a a1
-> WriterT
     (Map Reference ConstructorType) Identity (TermF v a a a1)
forall a. a -> WriterT (Map Reference ConstructorType) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> TermF v a a a1
forall typeVar typeAnn patternAnn a.
Text -> TermF typeVar typeAnn patternAnn a
Hashing.TermText Text
t)
  Memory.Term.Char Char
c -> TermF v a a a1
-> WriterT
     (Map Reference ConstructorType) Identity (TermF v a a a1)
forall a. a -> WriterT (Map Reference ConstructorType) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> TermF v a a a1
forall typeVar typeAnn patternAnn a.
Char -> TermF typeVar typeAnn patternAnn a
Hashing.TermChar Char
c)
  Memory.Term.Blank Blank a
b -> TermF v a a a1
-> WriterT
     (Map Reference ConstructorType) Identity (TermF v a a a1)
forall a. a -> WriterT (Map Reference ConstructorType) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Blank a -> TermF v a a a1
forall typeVar typeAnn patternAnn a.
Blank typeAnn -> TermF typeVar typeAnn patternAnn a
Hashing.TermBlank Blank a
b)
  Memory.Term.Ref Reference
r -> TermF v a a a1
-> WriterT
     (Map Reference ConstructorType) Identity (TermF v a a a1)
forall a. a -> WriterT (Map Reference ConstructorType) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Reference -> TermF v a a a1
forall typeVar typeAnn patternAnn a.
Reference -> TermF typeVar typeAnn patternAnn a
Hashing.TermRef (Reference -> Reference
m2hReference Reference
r))
  Memory.Term.Constructor (Memory.ConstructorReference.ConstructorReference Reference
r Word64
i) -> TermF v a a a1
-> WriterT
     (Map Reference ConstructorType) Identity (TermF v a a a1)
forall a. a -> WriterT (Map Reference ConstructorType) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Reference -> Word64 -> TermF v a a a1
forall typeVar typeAnn patternAnn a.
Reference -> Word64 -> TermF typeVar typeAnn patternAnn a
Hashing.TermConstructor (Reference -> Reference
m2hReference Reference
r) Word64
i)
  Memory.Term.Request (Memory.ConstructorReference.ConstructorReference Reference
r Word64
i) -> TermF v a a a1
-> WriterT
     (Map Reference ConstructorType) Identity (TermF v a a a1)
forall a. a -> WriterT (Map Reference ConstructorType) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Reference -> Word64 -> TermF v a a a1
forall typeVar typeAnn patternAnn a.
Reference -> Word64 -> TermF typeVar typeAnn patternAnn a
Hashing.TermRequest (Reference -> Reference
m2hReference Reference
r) Word64
i)
  Memory.Term.Handle a1
x a1
y -> TermF v a a a1
-> WriterT
     (Map Reference ConstructorType) Identity (TermF v a a a1)
forall a. a -> WriterT (Map Reference ConstructorType) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a1 -> a1 -> TermF v a a a1
forall typeVar typeAnn patternAnn a.
a -> a -> TermF typeVar typeAnn patternAnn a
Hashing.TermHandle a1
x a1
y)
  Memory.Term.App a1
f a1
x -> TermF v a a a1
-> WriterT
     (Map Reference ConstructorType) Identity (TermF v a a a1)
forall a. a -> WriterT (Map Reference ConstructorType) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a1 -> a1 -> TermF v a a a1
forall typeVar typeAnn patternAnn a.
a -> a -> TermF typeVar typeAnn patternAnn a
Hashing.TermApp a1
f a1
x)
  Memory.Term.Ann a1
e Type v a
t -> TermF v a a a1
-> WriterT
     (Map Reference ConstructorType) Identity (TermF v a a a1)
forall a. a -> WriterT (Map Reference ConstructorType) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a1 -> Type v a -> TermF v a a a1
forall typeVar typeAnn patternAnn a.
a -> Type typeVar typeAnn -> TermF typeVar typeAnn patternAnn a
Hashing.TermAnn a1
e (Type v a -> Type v a
forall v a. Ord v => Type v a -> Type v a
m2hType Type v a
t))
  Memory.Term.List Seq a1
as -> TermF v a a a1
-> WriterT
     (Map Reference ConstructorType) Identity (TermF v a a a1)
forall a. a -> WriterT (Map Reference ConstructorType) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Seq a1 -> TermF v a a a1
forall typeVar typeAnn patternAnn a.
Seq a -> TermF typeVar typeAnn patternAnn a
Hashing.TermList Seq a1
as)
  Memory.Term.And a1
p a1
q -> TermF v a a a1
-> WriterT
     (Map Reference ConstructorType) Identity (TermF v a a a1)
forall a. a -> WriterT (Map Reference ConstructorType) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a1 -> a1 -> TermF v a a a1
forall typeVar typeAnn patternAnn a.
a -> a -> TermF typeVar typeAnn patternAnn a
Hashing.TermAnd a1
p a1
q)
  Memory.Term.If a1
c a1
t a1
f -> TermF v a a a1
-> WriterT
     (Map Reference ConstructorType) Identity (TermF v a a a1)
forall a. a -> WriterT (Map Reference ConstructorType) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a1 -> a1 -> a1 -> TermF v a a a1
forall typeVar typeAnn patternAnn a.
a -> a -> a -> TermF typeVar typeAnn patternAnn a
Hashing.TermIf a1
c a1
t a1
f)
  Memory.Term.Or a1
p a1
q -> TermF v a a a1
-> WriterT
     (Map Reference ConstructorType) Identity (TermF v a a a1)
forall a. a -> WriterT (Map Reference ConstructorType) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a1 -> a1 -> TermF v a a a1
forall typeVar typeAnn patternAnn a.
a -> a -> TermF typeVar typeAnn patternAnn a
Hashing.TermOr a1
p a1
q)
  Memory.Term.Lam a1
a -> TermF v a a a1
-> WriterT
     (Map Reference ConstructorType) Identity (TermF v a a a1)
forall a. a -> WriterT (Map Reference ConstructorType) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a1 -> TermF v a a a1
forall typeVar typeAnn patternAnn a.
a -> TermF typeVar typeAnn patternAnn a
Hashing.TermLam a1
a)
  Memory.Term.LetRec Bool
_isTop [a1]
bs a1
body -> TermF v a a a1
-> WriterT
     (Map Reference ConstructorType) Identity (TermF v a a a1)
forall a. a -> WriterT (Map Reference ConstructorType) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a1] -> a1 -> TermF v a a a1
forall typeVar typeAnn patternAnn a.
[a] -> a -> TermF typeVar typeAnn patternAnn a
Hashing.TermLetRec [a1]
bs a1
body)
  Memory.Term.Let Bool
_isTop a1
b a1
body -> TermF v a a a1
-> WriterT
     (Map Reference ConstructorType) Identity (TermF v a a a1)
forall a. a -> WriterT (Map Reference ConstructorType) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a1 -> a1 -> TermF v a a a1
forall typeVar typeAnn patternAnn a.
a -> a -> TermF typeVar typeAnn patternAnn a
Hashing.TermLet a1
b a1
body)
  Memory.Term.Match a1
scr [MatchCase a a1]
cases -> TermF v a a a1
-> WriterT
     (Map Reference ConstructorType) Identity (TermF v a a a1)
forall a. a -> WriterT (Map Reference ConstructorType) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a1 -> [MatchCase a a1] -> TermF v a a a1
forall typeVar typeAnn patternAnn a.
a -> [MatchCase patternAnn a] -> TermF typeVar typeAnn patternAnn a
Hashing.TermMatch a1
scr ((MatchCase a a1 -> MatchCase a a1)
-> [MatchCase a a1] -> [MatchCase a a1]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MatchCase a a1 -> MatchCase a a1
forall a a1. MatchCase a a1 -> MatchCase a a1
m2hMatchCase [MatchCase a a1]
cases))
  Memory.Term.TermLink Referent
r -> Referent -> TermF v a a a1
forall typeVar typeAnn patternAnn a.
Referent -> TermF typeVar typeAnn patternAnn a
Hashing.TermTermLink (Referent -> TermF v a a a1)
-> WriterT (Map Reference ConstructorType) Identity Referent
-> WriterT
     (Map Reference ConstructorType) Identity (TermF v a a a1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Referent
-> WriterT (Map Reference ConstructorType) Identity Referent
m2hReferent Referent
r
  Memory.Term.TypeLink Reference
r -> TermF v a a a1
-> WriterT
     (Map Reference ConstructorType) Identity (TermF v a a a1)
forall a. a -> WriterT (Map Reference ConstructorType) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Reference -> TermF v a a a1
forall typeVar typeAnn patternAnn a.
Reference -> TermF typeVar typeAnn patternAnn a
Hashing.TermTypeLink (Reference -> Reference
m2hReference Reference
r))

m2hMatchCase :: Memory.Term.MatchCase a a1 -> Hashing.MatchCase a a1
m2hMatchCase :: forall a a1. MatchCase a a1 -> MatchCase a a1
m2hMatchCase (Memory.Term.MatchCase Pattern a
pat Maybe a1
m_a1 a1
a1) = Pattern a -> Maybe a1 -> a1 -> MatchCase a a1
forall loc a. Pattern loc -> Maybe a -> a -> MatchCase loc a
Hashing.MatchCase (Pattern a -> Pattern a
forall a. Pattern a -> Pattern a
m2hPattern Pattern a
pat) Maybe a1
m_a1 a1
a1

m2hPattern :: Memory.Pattern.Pattern a -> Hashing.Pattern a
m2hPattern :: forall a. Pattern a -> Pattern a
m2hPattern = \case
  Memory.Pattern.Unbound a
loc -> a -> Pattern a
forall loc. loc -> Pattern loc
Hashing.PatternUnbound a
loc
  Memory.Pattern.Var a
loc -> a -> Pattern a
forall loc. loc -> Pattern loc
Hashing.PatternVar a
loc
  Memory.Pattern.Boolean a
loc Bool
b -> a -> Bool -> Pattern a
forall loc. loc -> Bool -> Pattern loc
Hashing.PatternBoolean a
loc Bool
b
  Memory.Pattern.Int a
loc Int64
i -> a -> Int64 -> Pattern a
forall loc. loc -> Int64 -> Pattern loc
Hashing.PatternInt a
loc Int64
i
  Memory.Pattern.Nat a
loc Word64
n -> a -> Word64 -> Pattern a
forall loc. loc -> Word64 -> Pattern loc
Hashing.PatternNat a
loc Word64
n
  Memory.Pattern.Float a
loc Double
f -> a -> Double -> Pattern a
forall loc. loc -> Double -> Pattern loc
Hashing.PatternFloat a
loc Double
f
  Memory.Pattern.Text a
loc Text
t -> a -> Text -> Pattern a
forall loc. loc -> Text -> Pattern loc
Hashing.PatternText a
loc Text
t
  Memory.Pattern.Char a
loc Char
c -> a -> Char -> Pattern a
forall loc. loc -> Char -> Pattern loc
Hashing.PatternChar a
loc Char
c
  Memory.Pattern.Constructor a
loc (Memory.ConstructorReference.ConstructorReference Reference
r Word64
i) [Pattern a]
ps ->
    a -> Reference -> Word64 -> [Pattern a] -> Pattern a
forall loc.
loc -> Reference -> Word64 -> [Pattern loc] -> Pattern loc
Hashing.PatternConstructor a
loc (Reference -> Reference
m2hReference Reference
r) Word64
i ((Pattern a -> Pattern a) -> [Pattern a] -> [Pattern a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pattern a -> Pattern a
forall a. Pattern a -> Pattern a
m2hPattern [Pattern a]
ps)
  Memory.Pattern.As a
loc Pattern a
p -> a -> Pattern a -> Pattern a
forall loc. loc -> Pattern loc -> Pattern loc
Hashing.PatternAs a
loc (Pattern a -> Pattern a
forall a. Pattern a -> Pattern a
m2hPattern Pattern a
p)
  Memory.Pattern.EffectPure a
loc Pattern a
p -> a -> Pattern a -> Pattern a
forall loc. loc -> Pattern loc -> Pattern loc
Hashing.PatternEffectPure a
loc (Pattern a -> Pattern a
forall a. Pattern a -> Pattern a
m2hPattern Pattern a
p)
  Memory.Pattern.EffectBind a
loc (Memory.ConstructorReference.ConstructorReference Reference
r Word64
i) [Pattern a]
ps Pattern a
k ->
    a -> Reference -> Word64 -> [Pattern a] -> Pattern a -> Pattern a
forall loc.
loc
-> Reference
-> Word64
-> [Pattern loc]
-> Pattern loc
-> Pattern loc
Hashing.PatternEffectBind a
loc (Reference -> Reference
m2hReference Reference
r) Word64
i ((Pattern a -> Pattern a) -> [Pattern a] -> [Pattern a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pattern a -> Pattern a
forall a. Pattern a -> Pattern a
m2hPattern [Pattern a]
ps) (Pattern a -> Pattern a
forall a. Pattern a -> Pattern a
m2hPattern Pattern a
k)
  Memory.Pattern.SequenceLiteral a
loc [Pattern a]
ps -> a -> [Pattern a] -> Pattern a
forall loc. loc -> [Pattern loc] -> Pattern loc
Hashing.PatternSequenceLiteral a
loc ((Pattern a -> Pattern a) -> [Pattern a] -> [Pattern a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pattern a -> Pattern a
forall a. Pattern a -> Pattern a
m2hPattern [Pattern a]
ps)
  Memory.Pattern.SequenceOp a
loc Pattern a
l SeqOp
op Pattern a
r -> a -> Pattern a -> SeqOp -> Pattern a -> Pattern a
forall loc.
loc -> Pattern loc -> SeqOp -> Pattern loc -> Pattern loc
Hashing.PatternSequenceOp a
loc (Pattern a -> Pattern a
forall a. Pattern a -> Pattern a
m2hPattern Pattern a
l) (SeqOp -> SeqOp
m2hSequenceOp SeqOp
op) (Pattern a -> Pattern a
forall a. Pattern a -> Pattern a
m2hPattern Pattern a
r)

m2hSequenceOp :: Memory.Pattern.SeqOp -> Hashing.SeqOp
m2hSequenceOp :: SeqOp -> SeqOp
m2hSequenceOp = \case
  SeqOp
Memory.Pattern.Cons -> SeqOp
Hashing.Cons
  SeqOp
Memory.Pattern.Snoc -> SeqOp
Hashing.Snoc
  SeqOp
Memory.Pattern.Concat -> SeqOp
Hashing.Concat

m2hReferent :: Memory.Referent.Referent -> Writer (Map Memory.Reference.Reference Memory.ConstructorType.ConstructorType) Hashing.Referent
m2hReferent :: Referent
-> WriterT (Map Reference ConstructorType) Identity Referent
m2hReferent = \case
  Memory.Referent.Ref Reference
ref -> Referent
-> WriterT (Map Reference ConstructorType) Identity Referent
forall a. a -> WriterT (Map Reference ConstructorType) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Reference -> Referent
Hashing.ReferentRef (Reference -> Reference
m2hReference Reference
ref))
  Memory.Referent.Con (Memory.ConstructorReference.ConstructorReference Reference
ref Word64
n) ConstructorType
ct -> do
    Map Reference ConstructorType
-> WriterT (Map Reference ConstructorType) Identity ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
Writer.tell (Reference -> ConstructorType -> Map Reference ConstructorType
forall k a. k -> a -> Map k a
Map.singleton Reference
ref ConstructorType
ct)
    pure (Reference -> Word64 -> Referent
Hashing.ReferentCon (Reference -> Reference
m2hReference Reference
ref) Word64
n)

h2mTerm :: (Ord v) => (Memory.Reference.Reference -> Memory.ConstructorType.ConstructorType) -> Hashing.Term v a -> Memory.Term.Term v a
h2mTerm :: forall v a.
Ord v =>
(Reference -> ConstructorType) -> Term v a -> Term v a
h2mTerm Reference -> ConstructorType
getCT = (forall a1. TermF v a a a1 -> F v a a a1)
-> Term (TermF v a a) v a -> Term (F v a a) v a
forall v (g :: * -> *) (f :: * -> *) a.
(Ord v, Foldable g, Functor g) =>
(forall a1. f a1 -> g a1) -> Term f v a -> Term g v a
ABT.transform \case
  Hashing.TermInt Int64
i -> Int64 -> F v a a a1
forall typeVar typeAnn patternAnn a.
Int64 -> F typeVar typeAnn patternAnn a
Memory.Term.Int Int64
i
  Hashing.TermNat Word64
n -> Word64 -> F v a a a1
forall typeVar typeAnn patternAnn a.
Word64 -> F typeVar typeAnn patternAnn a
Memory.Term.Nat Word64
n
  Hashing.TermFloat Double
d -> Double -> F v a a a1
forall typeVar typeAnn patternAnn a.
Double -> F typeVar typeAnn patternAnn a
Memory.Term.Float Double
d
  Hashing.TermBoolean Bool
b -> Bool -> F v a a a1
forall typeVar typeAnn patternAnn a.
Bool -> F typeVar typeAnn patternAnn a
Memory.Term.Boolean Bool
b
  Hashing.TermText Text
t -> Text -> F v a a a1
forall typeVar typeAnn patternAnn a.
Text -> F typeVar typeAnn patternAnn a
Memory.Term.Text Text
t
  Hashing.TermChar Char
c -> Char -> F v a a a1
forall typeVar typeAnn patternAnn a.
Char -> F typeVar typeAnn patternAnn a
Memory.Term.Char Char
c
  Hashing.TermBlank Blank a
b -> Blank a -> F v a a a1
forall typeVar typeAnn patternAnn a.
Blank typeAnn -> F typeVar typeAnn patternAnn a
Memory.Term.Blank Blank a
b
  Hashing.TermRef Reference
r -> Reference -> F v a a a1
forall typeVar typeAnn patternAnn a.
Reference -> F typeVar typeAnn patternAnn a
Memory.Term.Ref (Reference -> Reference
h2mReference Reference
r)
  Hashing.TermConstructor Reference
r Word64
i -> GConstructorReference Reference -> F v a a a1
forall typeVar typeAnn patternAnn a.
GConstructorReference Reference -> F typeVar typeAnn patternAnn a
Memory.Term.Constructor (Reference -> Word64 -> GConstructorReference Reference
forall r. r -> Word64 -> GConstructorReference r
Memory.ConstructorReference.ConstructorReference (Reference -> Reference
h2mReference Reference
r) Word64
i)
  Hashing.TermRequest Reference
r Word64
i -> GConstructorReference Reference -> F v a a a1
forall typeVar typeAnn patternAnn a.
GConstructorReference Reference -> F typeVar typeAnn patternAnn a
Memory.Term.Request (Reference -> Word64 -> GConstructorReference Reference
forall r. r -> Word64 -> GConstructorReference r
Memory.ConstructorReference.ConstructorReference (Reference -> Reference
h2mReference Reference
r) Word64
i)
  Hashing.TermHandle a1
x a1
y -> a1 -> a1 -> F v a a a1
forall typeVar typeAnn patternAnn a.
a -> a -> F typeVar typeAnn patternAnn a
Memory.Term.Handle a1
x a1
y
  Hashing.TermApp a1
f a1
x -> a1 -> a1 -> F v a a a1
forall typeVar typeAnn patternAnn a.
a -> a -> F typeVar typeAnn patternAnn a
Memory.Term.App a1
f a1
x
  Hashing.TermAnn a1
e Type v a
t -> a1 -> Type v a -> F v a a a1
forall typeVar typeAnn patternAnn a.
a -> Type typeVar typeAnn -> F typeVar typeAnn patternAnn a
Memory.Term.Ann a1
e (Type v a -> Type v a
forall v a. Ord v => Type v a -> Type v a
h2mType Type v a
t)
  Hashing.TermList Seq a1
as -> Seq a1 -> F v a a a1
forall typeVar typeAnn patternAnn a.
Seq a -> F typeVar typeAnn patternAnn a
Memory.Term.List Seq a1
as
  Hashing.TermIf a1
c a1
t a1
f -> a1 -> a1 -> a1 -> F v a a a1
forall typeVar typeAnn patternAnn a.
a -> a -> a -> F typeVar typeAnn patternAnn a
Memory.Term.If a1
c a1
t a1
f
  Hashing.TermAnd a1
p a1
q -> a1 -> a1 -> F v a a a1
forall typeVar typeAnn patternAnn a.
a -> a -> F typeVar typeAnn patternAnn a
Memory.Term.And a1
p a1
q
  Hashing.TermOr a1
p a1
q -> a1 -> a1 -> F v a a a1
forall typeVar typeAnn patternAnn a.
a -> a -> F typeVar typeAnn patternAnn a
Memory.Term.Or a1
p a1
q
  Hashing.TermLam a1
a -> a1 -> F v a a a1
forall typeVar typeAnn patternAnn a.
a -> F typeVar typeAnn patternAnn a
Memory.Term.Lam a1
a
  Hashing.TermLetRec [a1]
bs a1
body -> Bool -> [a1] -> a1 -> F v a a a1
forall typeVar typeAnn patternAnn a.
Bool -> [a] -> a -> F typeVar typeAnn patternAnn a
Memory.Term.LetRec Bool
False [a1]
bs a1
body
  Hashing.TermLet a1
b a1
body -> Bool -> a1 -> a1 -> F v a a a1
forall typeVar typeAnn patternAnn a.
Bool -> a -> a -> F typeVar typeAnn patternAnn a
Memory.Term.Let Bool
False a1
b a1
body
  Hashing.TermMatch a1
scr [MatchCase a a1]
cases -> a1 -> [MatchCase a a1] -> F v a a a1
forall typeVar typeAnn patternAnn a.
a -> [MatchCase patternAnn a] -> F typeVar typeAnn patternAnn a
Memory.Term.Match a1
scr (MatchCase a a1 -> MatchCase a a1
forall a b. MatchCase a b -> MatchCase a b
h2mMatchCase (MatchCase a a1 -> MatchCase a a1)
-> [MatchCase a a1] -> [MatchCase a a1]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [MatchCase a a1]
cases)
  Hashing.TermTermLink Referent
r -> Referent -> F v a a a1
forall typeVar typeAnn patternAnn a.
Referent -> F typeVar typeAnn patternAnn a
Memory.Term.TermLink ((Reference -> ConstructorType) -> Referent -> Referent
h2mReferent Reference -> ConstructorType
getCT Referent
r)
  Hashing.TermTypeLink Reference
r -> Reference -> F v a a a1
forall typeVar typeAnn patternAnn a.
Reference -> F typeVar typeAnn patternAnn a
Memory.Term.TypeLink (Reference -> Reference
h2mReference Reference
r)

h2mMatchCase :: Hashing.MatchCase a b -> Memory.Term.MatchCase a b
h2mMatchCase :: forall a b. MatchCase a b -> MatchCase a b
h2mMatchCase (Hashing.MatchCase Pattern a
pat Maybe b
m_b b
b) = Pattern a -> Maybe b -> b -> MatchCase a b
forall loc a. Pattern loc -> Maybe a -> a -> MatchCase loc a
Memory.Term.MatchCase (Pattern a -> Pattern a
forall a. Pattern a -> Pattern a
h2mPattern Pattern a
pat) Maybe b
m_b b
b

h2mPattern :: Hashing.Pattern a -> Memory.Pattern.Pattern a
h2mPattern :: forall a. Pattern a -> Pattern a
h2mPattern = \case
  Hashing.PatternUnbound a
loc -> a -> Pattern a
forall loc. loc -> Pattern loc
Memory.Pattern.Unbound a
loc
  Hashing.PatternVar a
loc -> a -> Pattern a
forall loc. loc -> Pattern loc
Memory.Pattern.Var a
loc
  Hashing.PatternBoolean a
loc Bool
b -> a -> Bool -> Pattern a
forall loc. loc -> Bool -> Pattern loc
Memory.Pattern.Boolean a
loc Bool
b
  Hashing.PatternInt a
loc Int64
i -> a -> Int64 -> Pattern a
forall loc. loc -> Int64 -> Pattern loc
Memory.Pattern.Int a
loc Int64
i
  Hashing.PatternNat a
loc Word64
n -> a -> Word64 -> Pattern a
forall loc. loc -> Word64 -> Pattern loc
Memory.Pattern.Nat a
loc Word64
n
  Hashing.PatternFloat a
loc Double
f -> a -> Double -> Pattern a
forall loc. loc -> Double -> Pattern loc
Memory.Pattern.Float a
loc Double
f
  Hashing.PatternText a
loc Text
t -> a -> Text -> Pattern a
forall loc. loc -> Text -> Pattern loc
Memory.Pattern.Text a
loc Text
t
  Hashing.PatternChar a
loc Char
c -> a -> Char -> Pattern a
forall loc. loc -> Char -> Pattern loc
Memory.Pattern.Char a
loc Char
c
  Hashing.PatternConstructor a
loc Reference
r Word64
i [Pattern a]
ps ->
    a -> GConstructorReference Reference -> [Pattern a] -> Pattern a
forall loc.
loc
-> GConstructorReference Reference -> [Pattern loc] -> Pattern loc
Memory.Pattern.Constructor a
loc (Reference -> Word64 -> GConstructorReference Reference
forall r. r -> Word64 -> GConstructorReference r
Memory.ConstructorReference.ConstructorReference (Reference -> Reference
h2mReference Reference
r) Word64
i) (Pattern a -> Pattern a
forall a. Pattern a -> Pattern a
h2mPattern (Pattern a -> Pattern a) -> [Pattern a] -> [Pattern a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Pattern a]
ps)
  Hashing.PatternAs a
loc Pattern a
p -> a -> Pattern a -> Pattern a
forall loc. loc -> Pattern loc -> Pattern loc
Memory.Pattern.As a
loc (Pattern a -> Pattern a
forall a. Pattern a -> Pattern a
h2mPattern Pattern a
p)
  Hashing.PatternEffectPure a
loc Pattern a
p -> a -> Pattern a -> Pattern a
forall loc. loc -> Pattern loc -> Pattern loc
Memory.Pattern.EffectPure a
loc (Pattern a -> Pattern a
forall a. Pattern a -> Pattern a
h2mPattern Pattern a
p)
  Hashing.PatternEffectBind a
loc Reference
r Word64
i [Pattern a]
ps Pattern a
k ->
    a
-> GConstructorReference Reference
-> [Pattern a]
-> Pattern a
-> Pattern a
forall loc.
loc
-> GConstructorReference Reference
-> [Pattern loc]
-> Pattern loc
-> Pattern loc
Memory.Pattern.EffectBind a
loc (Reference -> Word64 -> GConstructorReference Reference
forall r. r -> Word64 -> GConstructorReference r
Memory.ConstructorReference.ConstructorReference (Reference -> Reference
h2mReference Reference
r) Word64
i) (Pattern a -> Pattern a
forall a. Pattern a -> Pattern a
h2mPattern (Pattern a -> Pattern a) -> [Pattern a] -> [Pattern a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Pattern a]
ps) (Pattern a -> Pattern a
forall a. Pattern a -> Pattern a
h2mPattern Pattern a
k)
  Hashing.PatternSequenceLiteral a
loc [Pattern a]
ps -> a -> [Pattern a] -> Pattern a
forall loc. loc -> [Pattern loc] -> Pattern loc
Memory.Pattern.SequenceLiteral a
loc (Pattern a -> Pattern a
forall a. Pattern a -> Pattern a
h2mPattern (Pattern a -> Pattern a) -> [Pattern a] -> [Pattern a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Pattern a]
ps)
  Hashing.PatternSequenceOp a
loc Pattern a
l SeqOp
op Pattern a
r -> a -> Pattern a -> SeqOp -> Pattern a -> Pattern a
forall loc.
loc -> Pattern loc -> SeqOp -> Pattern loc -> Pattern loc
Memory.Pattern.SequenceOp a
loc (Pattern a -> Pattern a
forall a. Pattern a -> Pattern a
h2mPattern Pattern a
l) (SeqOp -> SeqOp
h2mSequenceOp SeqOp
op) (Pattern a -> Pattern a
forall a. Pattern a -> Pattern a
h2mPattern Pattern a
r)

h2mSequenceOp :: Hashing.SeqOp -> Memory.Pattern.SeqOp
h2mSequenceOp :: SeqOp -> SeqOp
h2mSequenceOp = \case
  SeqOp
Hashing.Cons -> SeqOp
Memory.Pattern.Cons
  SeqOp
Hashing.Snoc -> SeqOp
Memory.Pattern.Snoc
  SeqOp
Hashing.Concat -> SeqOp
Memory.Pattern.Concat

h2mReferent :: (Memory.Reference.Reference -> Memory.ConstructorType.ConstructorType) -> Hashing.Referent -> Memory.Referent.Referent
h2mReferent :: (Reference -> ConstructorType) -> Referent -> Referent
h2mReferent Reference -> ConstructorType
getCT = \case
  Hashing.ReferentRef Reference
ref -> Reference -> Referent
Memory.Referent.Ref (Reference -> Reference
h2mReference Reference
ref)
  Hashing.ReferentCon Reference
ref Word64
n ->
    let mRef :: Reference
mRef = Reference -> Reference
h2mReference Reference
ref
     in GConstructorReference Reference -> ConstructorType -> Referent
Memory.Referent.Con (Reference -> Word64 -> GConstructorReference Reference
forall r. r -> Word64 -> GConstructorReference r
Memory.ConstructorReference.ConstructorReference Reference
mRef Word64
n) (Reference -> ConstructorType
getCT Reference
mRef)

hashDataDecls ::
  (Var v) =>
  Map v (Memory.DD.DataDeclaration v a) ->
  ResolutionResult a [(v, Memory.Reference.Id, Memory.DD.DataDeclaration v a)]
hashDataDecls :: forall v a.
Var v =>
Map v (DataDeclaration v a)
-> ResolutionResult a [(v, TermReferenceId, DataDeclaration v a)]
hashDataDecls Map v (DataDeclaration v a)
memDecls = do
  let hashingDecls :: Map v (DataDeclaration v a)
hashingDecls = (DataDeclaration v a -> DataDeclaration v a)
-> Map v (DataDeclaration v a) -> Map v (DataDeclaration v a)
forall a b. (a -> b) -> Map v a -> Map v b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DataDeclaration v a -> DataDeclaration v a
forall v a. Ord v => DataDeclaration v a -> DataDeclaration v a
m2hDecl Map v (DataDeclaration v a)
memDecls
  [(v, ReferenceId, DataDeclaration v a)]
hashingResult <- (v -> Name)
-> Map v (DataDeclaration v a)
-> ResolutionResult a [(v, ReferenceId, DataDeclaration v a)]
forall v a.
(Eq v, Var v, Show v) =>
(v -> Name)
-> Map v (DataDeclaration v a)
-> ResolutionResult a [(v, ReferenceId, DataDeclaration v a)]
Hashing.hashDecls v -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar Map v (DataDeclaration v a)
hashingDecls
  pure $ ((v, ReferenceId, DataDeclaration v a)
 -> (v, TermReferenceId, DataDeclaration v a))
-> [(v, ReferenceId, DataDeclaration v a)]
-> [(v, TermReferenceId, DataDeclaration v a)]
forall a b. (a -> b) -> [a] -> [b]
map (v, ReferenceId, DataDeclaration v a)
-> (v, TermReferenceId, DataDeclaration v a)
forall v a.
Ord v =>
(v, ReferenceId, DataDeclaration v a)
-> (v, TermReferenceId, DataDeclaration v a)
h2mDeclResult [(v, ReferenceId, DataDeclaration v a)]
hashingResult
  where
    h2mDeclResult :: (Ord v) => (v, Hashing.ReferenceId, Hashing.DataDeclaration v a) -> (v, Memory.Reference.Id, Memory.DD.DataDeclaration v a)
    h2mDeclResult :: forall v a.
Ord v =>
(v, ReferenceId, DataDeclaration v a)
-> (v, TermReferenceId, DataDeclaration v a)
h2mDeclResult (v
v, ReferenceId
id, DataDeclaration v a
dd) = (v
v, ReferenceId -> TermReferenceId
h2mReferenceId ReferenceId
id, DataDeclaration v a -> DataDeclaration v a
forall v a. Ord v => DataDeclaration v a -> DataDeclaration v a
h2mDecl DataDeclaration v a
dd)

hashDecls ::
  (Var v) =>
  Map v (Memory.DD.Decl v a) ->
  ResolutionResult a [(v, Memory.Reference.Id, Memory.DD.Decl v a)]
hashDecls :: forall v a.
Var v =>
Map v (Decl v a)
-> ResolutionResult a [(v, TermReferenceId, Decl v a)]
hashDecls Map v (Decl v a)
memDecls = do
  -- want to unwrap the decl before doing the rehashing, and then wrap it back up the same way
  let howToReassemble :: Map v ConstructorType
howToReassemble =
        Map v (Decl v a)
memDecls Map v (Decl v a)
-> (Decl v a -> ConstructorType) -> Map v ConstructorType
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
          Left {} -> ConstructorType
CT.Effect
          Right {} -> ConstructorType
CT.Data
      memDeclsAsDDs :: Map v (DataDeclaration v a)
memDeclsAsDDs = Decl v a -> DataDeclaration v a
forall v a. Decl v a -> DataDeclaration v a
Memory.DD.asDataDecl (Decl v a -> DataDeclaration v a)
-> Map v (Decl v a) -> Map v (DataDeclaration v a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map v (Decl v a)
memDecls
  [(v, TermReferenceId, DataDeclaration v a)]
result <- Map v (DataDeclaration v a)
-> ResolutionResult a [(v, TermReferenceId, DataDeclaration v a)]
forall v a.
Var v =>
Map v (DataDeclaration v a)
-> ResolutionResult a [(v, TermReferenceId, DataDeclaration v a)]
hashDataDecls Map v (DataDeclaration v a)
memDeclsAsDDs
  pure $
    [(v, TermReferenceId, DataDeclaration v a)]
result [(v, TermReferenceId, DataDeclaration v a)]
-> ((v, TermReferenceId, DataDeclaration v a)
    -> (v, TermReferenceId, Decl v a))
-> [(v, TermReferenceId, Decl v a)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(v
v, TermReferenceId
id', DataDeclaration v a
decl) ->
      case v -> Map v ConstructorType -> Maybe ConstructorType
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup v
v Map v ConstructorType
howToReassemble of
        Maybe ConstructorType
Nothing -> [Char] -> (v, TermReferenceId, Decl v a)
forall a. HasCallStack => [Char] -> a
error [Char]
"Unknown v in hashDecls'"
        Just ConstructorType
ct -> (v
v, TermReferenceId
id', ConstructorType -> DataDeclaration v a -> Decl v a
forall v a. ConstructorType -> DataDeclaration v a -> Decl v a
retag ConstructorType
ct DataDeclaration v a
decl)
  where
    retag :: CT.ConstructorType -> Memory.DD.DataDeclaration v a -> Memory.DD.Decl v a
    retag :: forall v a. ConstructorType -> DataDeclaration v a -> Decl v a
retag ConstructorType
CT.Effect = EffectDeclaration v a
-> Either (EffectDeclaration v a) (DataDeclaration v a)
forall a b. a -> Either a b
Left (EffectDeclaration v a
 -> Either (EffectDeclaration v a) (DataDeclaration v a))
-> (DataDeclaration v a -> EffectDeclaration v a)
-> DataDeclaration v a
-> Either (EffectDeclaration v a) (DataDeclaration v a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataDeclaration v a -> EffectDeclaration v a
forall v a. DataDeclaration v a -> EffectDeclaration v a
Memory.DD.EffectDeclaration
    retag ConstructorType
CT.Data = DataDeclaration v a
-> Either (EffectDeclaration v a) (DataDeclaration v a)
forall a b. b -> Either a b
Right

m2hDecl :: (Ord v) => Memory.DD.DataDeclaration v a -> Hashing.DataDeclaration v a
m2hDecl :: forall v a. Ord v => DataDeclaration v a -> DataDeclaration v a
m2hDecl (Memory.DD.DataDeclaration Modifier
mod a
ann [v]
bound [(a, v, Type v a)]
ctors) =
  Modifier -> a -> [v] -> [(a, v, Type v a)] -> DataDeclaration v a
forall v a.
Modifier -> a -> [v] -> [(a, v, Type v a)] -> DataDeclaration v a
Hashing.DataDeclaration (Modifier -> Modifier
m2hModifier Modifier
mod) a
ann [v]
bound ([(a, v, Type v a)] -> DataDeclaration v a)
-> [(a, v, Type v a)] -> DataDeclaration v a
forall a b. (a -> b) -> a -> b
$ ((a, v, Type v a) -> (a, v, Type v a))
-> [(a, v, Type v a)] -> [(a, v, Type v a)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ASetter (a, v, Type v a) (a, v, Type v a) (Type v a) (Type v a)
-> (Type v a -> Type v a) -> (a, v, Type v a) -> (a, v, Type v a)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
Lens.over ASetter (a, v, Type v a) (a, v, Type v a) (Type v a) (Type v a)
forall s t a b. Field3 s t a b => Lens s t a b
Lens (a, v, Type v a) (a, v, Type v a) (Type v a) (Type v a)
_3 Type v a -> Type v a
forall v a. Ord v => Type v a -> Type v a
m2hType) [(a, v, Type v a)]
ctors

m2hType :: (Ord v) => Memory.Type.Type v a -> Hashing.Type v a
m2hType :: forall v a. Ord v => Type v a -> Type v a
m2hType = (forall a1. F a1 -> TypeF a1) -> Term F v a -> Term TypeF v a
forall v (g :: * -> *) (f :: * -> *) a.
(Ord v, Foldable g, Functor g) =>
(forall a1. f a1 -> g a1) -> Term f v a -> Term g v a
ABT.transform \case
  Memory.Type.Ref Reference
ref -> Reference -> TypeF a1
forall a. Reference -> TypeF a
Hashing.TypeRef (Reference -> Reference
m2hReference Reference
ref)
  Memory.Type.Arrow a1
a1 a1
a1' -> a1 -> a1 -> TypeF a1
forall a. a -> a -> TypeF a
Hashing.TypeArrow a1
a1 a1
a1'
  Memory.Type.Ann a1
a1 Kind
ki -> a1 -> Kind -> TypeF a1
forall a. a -> Kind -> TypeF a
Hashing.TypeAnn a1
a1 (Kind -> Kind
m2hKind Kind
ki)
  Memory.Type.App a1
a1 a1
a1' -> a1 -> a1 -> TypeF a1
forall a. a -> a -> TypeF a
Hashing.TypeApp a1
a1 a1
a1'
  Memory.Type.Effect a1
a1 a1
a1' -> a1 -> a1 -> TypeF a1
forall a. a -> a -> TypeF a
Hashing.TypeEffect a1
a1 a1
a1'
  Memory.Type.Effects [a1]
a1s -> [a1] -> TypeF a1
forall a. [a] -> TypeF a
Hashing.TypeEffects [a1]
a1s
  Memory.Type.Forall a1
a1 -> a1 -> TypeF a1
forall a. a -> TypeF a
Hashing.TypeForall a1
a1
  Memory.Type.IntroOuter a1
a1 -> a1 -> TypeF a1
forall a. a -> TypeF a
Hashing.TypeIntroOuter a1
a1

m2hKind :: Memory.Kind.Kind -> Hashing.Kind
m2hKind :: Kind -> Kind
m2hKind = \case
  Kind
Memory.Kind.Star -> Kind
Hashing.KindStar
  Memory.Kind.Arrow Kind
k1 Kind
k2 -> Kind -> Kind -> Kind
Hashing.KindArrow (Kind -> Kind
m2hKind Kind
k1) (Kind -> Kind
m2hKind Kind
k2)

m2hReference :: Memory.Reference.Reference -> Hashing.Reference
m2hReference :: Reference -> Reference
m2hReference = \case
  Memory.Reference.Builtin Text
t -> Text -> Reference
Hashing.ReferenceBuiltin Text
t
  Memory.Reference.DerivedId TermReferenceId
d -> ReferenceId -> Reference
Hashing.ReferenceDerivedId (TermReferenceId -> ReferenceId
m2hReferenceId TermReferenceId
d)

m2hReferenceId :: Memory.Reference.Id -> Hashing.ReferenceId
m2hReferenceId :: TermReferenceId -> ReferenceId
m2hReferenceId (Memory.Reference.Id Hash
h Word64
i) = Hash -> Word64 -> ReferenceId
Hashing.ReferenceId Hash
h Word64
i

h2mModifier :: Hashing.Modifier -> Memory.DD.Modifier
h2mModifier :: Modifier -> Modifier
h2mModifier = \case
  Modifier
Hashing.Structural -> Modifier
Memory.DD.Structural
  Hashing.Unique Text
text -> Text -> Modifier
Memory.DD.Unique Text
text

m2hModifier :: Memory.DD.Modifier -> Hashing.Modifier
m2hModifier :: Modifier -> Modifier
m2hModifier = \case
  Modifier
Memory.DD.Structural -> Modifier
Hashing.Structural
  Memory.DD.Unique Text
text -> Text -> Modifier
Hashing.Unique Text
text

h2mDecl :: (Ord v) => Hashing.DataDeclaration v a -> Memory.DD.DataDeclaration v a
h2mDecl :: forall v a. Ord v => DataDeclaration v a -> DataDeclaration v a
h2mDecl (Hashing.DataDeclaration Modifier
mod a
ann [v]
bound [(a, v, Type v a)]
ctors) =
  Modifier -> a -> [v] -> [(a, v, Type v a)] -> DataDeclaration v a
forall v a.
Modifier -> a -> [v] -> [(a, v, Type v a)] -> DataDeclaration v a
Memory.DD.DataDeclaration (Modifier -> Modifier
h2mModifier Modifier
mod) a
ann [v]
bound (ASetter (a, v, Type v a) (a, v, Type v a) (Type v a) (Type v a)
-> (Type v a -> Type v a) -> (a, v, Type v a) -> (a, v, Type v a)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (a, v, Type v a) (a, v, Type v a) (Type v a) (Type v a)
forall s t a b. Field3 s t a b => Lens s t a b
Lens (a, v, Type v a) (a, v, Type v a) (Type v a) (Type v a)
_3 Type v a -> Type v a
forall v a. Ord v => Type v a -> Type v a
h2mType ((a, v, Type v a) -> (a, v, Type v a))
-> [(a, v, Type v a)] -> [(a, v, Type v a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(a, v, Type v a)]
ctors)

h2mType :: (Ord v) => Hashing.Type v a -> Memory.Type.Type v a
h2mType :: forall v a. Ord v => Type v a -> Type v a
h2mType = (forall a1. TypeF a1 -> F a1) -> Term TypeF v a -> Term F v a
forall v (g :: * -> *) (f :: * -> *) a.
(Ord v, Foldable g, Functor g) =>
(forall a1. f a1 -> g a1) -> Term f v a -> Term g v a
ABT.transform \case
  Hashing.TypeRef Reference
ref -> Reference -> F a1
forall a. Reference -> F a
Memory.Type.Ref (Reference -> Reference
h2mReference Reference
ref)
  Hashing.TypeArrow a1
a1 a1
a1' -> a1 -> a1 -> F a1
forall a. a -> a -> F a
Memory.Type.Arrow a1
a1 a1
a1'
  Hashing.TypeAnn a1
a1 Kind
ki -> a1 -> Kind -> F a1
forall a. a -> Kind -> F a
Memory.Type.Ann a1
a1 (Kind -> Kind
h2mKind Kind
ki)
  Hashing.TypeApp a1
a1 a1
a1' -> a1 -> a1 -> F a1
forall a. a -> a -> F a
Memory.Type.App a1
a1 a1
a1'
  Hashing.TypeEffect a1
a1 a1
a1' -> a1 -> a1 -> F a1
forall a. a -> a -> F a
Memory.Type.Effect a1
a1 a1
a1'
  Hashing.TypeEffects [a1]
a1s -> [a1] -> F a1
forall a. [a] -> F a
Memory.Type.Effects [a1]
a1s
  Hashing.TypeForall a1
a1 -> a1 -> F a1
forall a. a -> F a
Memory.Type.Forall a1
a1
  Hashing.TypeIntroOuter a1
a1 -> a1 -> F a1
forall a. a -> F a
Memory.Type.IntroOuter a1
a1

h2mKind :: Hashing.Kind -> Memory.Kind.Kind
h2mKind :: Kind -> Kind
h2mKind = \case
  Kind
Hashing.KindStar -> Kind
Memory.Kind.Star
  Hashing.KindArrow Kind
k1 Kind
k2 -> Kind -> Kind -> Kind
Memory.Kind.Arrow (Kind -> Kind
h2mKind Kind
k1) (Kind -> Kind
h2mKind Kind
k2)

h2mReference :: Hashing.Reference -> Memory.Reference.Reference
h2mReference :: Reference -> Reference
h2mReference = \case
  Hashing.ReferenceBuiltin Text
t -> Text -> Reference
forall t h. t -> Reference' t h
Memory.Reference.Builtin Text
t
  Hashing.ReferenceDerivedId ReferenceId
d -> TermReferenceId -> Reference
forall h t. Id' h -> Reference' t h
Memory.Reference.DerivedId (ReferenceId -> TermReferenceId
h2mReferenceId ReferenceId
d)

h2mReferenceId :: Hashing.ReferenceId -> Memory.Reference.Id
h2mReferenceId :: ReferenceId -> TermReferenceId
h2mReferenceId (Hashing.ReferenceId Hash
h Word64
i) = Hash -> Word64 -> TermReferenceId
forall h. h -> Word64 -> Id' h
Memory.Reference.Id Hash
h Word64
i

m2hPatch :: Memory.Patch.Patch -> Hashing.Patch
m2hPatch :: Patch -> Patch
m2hPatch (Memory.Patch.Patch Relation Reference TermEdit
termEdits Relation Reference TypeEdit
typeEdits) =
  Map Referent (Set TermEdit)
-> Map Reference (Set TypeEdit) -> Patch
Hashing.Patch Map Referent (Set TermEdit)
termEdits' Map Reference (Set TypeEdit)
typeEdits'
  where
    typeEdits' :: Map Reference (Set TypeEdit)
typeEdits' =
      [(Reference, Set TypeEdit)] -> Map Reference (Set TypeEdit)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        ([(Reference, Set TypeEdit)] -> Map Reference (Set TypeEdit))
-> (Map Reference (Set TypeEdit) -> [(Reference, Set TypeEdit)])
-> Map Reference (Set TypeEdit)
-> Map Reference (Set TypeEdit)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Reference, Set TypeEdit) -> (Reference, Set TypeEdit))
-> [(Reference, Set TypeEdit)] -> [(Reference, Set TypeEdit)]
forall a b. (a -> b) -> [a] -> [b]
map ((Reference -> Reference)
-> (Set TypeEdit -> Set TypeEdit)
-> (Reference, Set TypeEdit)
-> (Reference, Set TypeEdit)
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
m2hReference ((TypeEdit -> TypeEdit) -> Set TypeEdit -> Set TypeEdit
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map TypeEdit -> TypeEdit
m2hTypeEdit))
        ([(Reference, Set TypeEdit)] -> [(Reference, Set TypeEdit)])
-> (Map Reference (Set TypeEdit) -> [(Reference, Set TypeEdit)])
-> Map Reference (Set TypeEdit)
-> [(Reference, Set TypeEdit)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Reference (Set TypeEdit) -> [(Reference, Set TypeEdit)]
forall k a. Map k a -> [(k, a)]
Map.toList
        (Map Reference (Set TypeEdit) -> Map Reference (Set TypeEdit))
-> Map Reference (Set TypeEdit) -> Map Reference (Set TypeEdit)
forall a b. (a -> b) -> a -> b
$ Relation Reference TypeEdit -> Map Reference (Set TypeEdit)
forall a b. Relation a b -> Map a (Set b)
Relation.toMultimap Relation Reference TypeEdit
typeEdits
    termEdits' :: Map Referent (Set TermEdit)
termEdits' =
      [(Referent, Set TermEdit)] -> Map Referent (Set TermEdit)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        ([(Referent, Set TermEdit)] -> Map Referent (Set TermEdit))
-> (Map Reference (Set TermEdit) -> [(Referent, Set TermEdit)])
-> Map Reference (Set TermEdit)
-> Map Referent (Set TermEdit)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Reference, Set TermEdit) -> (Referent, Set TermEdit))
-> [(Reference, Set TermEdit)] -> [(Referent, Set TermEdit)]
forall a b. (a -> b) -> [a] -> [b]
map ((Reference -> Referent)
-> (Set TermEdit -> Set TermEdit)
-> (Reference, Set TermEdit)
-> (Referent, Set TermEdit)
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 -> Referent
Hashing.ReferentRef (Reference -> Referent)
-> (Reference -> Reference) -> Reference -> Referent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> Reference
m2hReference) ((TermEdit -> TermEdit) -> Set TermEdit -> Set TermEdit
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map TermEdit -> TermEdit
m2hTermEdit))
        ([(Reference, Set TermEdit)] -> [(Referent, Set TermEdit)])
-> (Map Reference (Set TermEdit) -> [(Reference, Set TermEdit)])
-> Map Reference (Set TermEdit)
-> [(Referent, Set TermEdit)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Reference (Set TermEdit) -> [(Reference, Set TermEdit)]
forall k a. Map k a -> [(k, a)]
Map.toList
        (Map Reference (Set TermEdit) -> Map Referent (Set TermEdit))
-> Map Reference (Set TermEdit) -> Map Referent (Set TermEdit)
forall a b. (a -> b) -> a -> b
$ Relation Reference TermEdit -> Map Reference (Set TermEdit)
forall a b. Relation a b -> Map a (Set b)
Relation.toMultimap Relation Reference TermEdit
termEdits
    m2hTermEdit :: TermEdit -> TermEdit
m2hTermEdit = \case
      Memory.TermEdit.Replace Reference
r Typing
_ -> Referent -> TermEdit
Hashing.TermEditReplace (Reference -> Referent
Hashing.ReferentRef (Reference -> Referent) -> Reference -> Referent
forall a b. (a -> b) -> a -> b
$ Reference -> Reference
m2hReference Reference
r)
      TermEdit
Memory.TermEdit.Deprecate -> TermEdit
Hashing.TermEditDeprecate
    m2hTypeEdit :: TypeEdit -> TypeEdit
m2hTypeEdit = \case
      Memory.TypeEdit.Replace Reference
r -> Reference -> TypeEdit
Hashing.TypeEditReplace (Reference -> Reference
m2hReference Reference
r)
      TypeEdit
Memory.TypeEdit.Deprecate -> TypeEdit
Hashing.TypeEditDeprecate

hashPatch :: Memory.Patch.Patch -> Hash
hashPatch :: Patch -> Hash
hashPatch = Patch -> Hash
forall a. ContentAddressable a => a -> Hash
Hashing.contentHash (Patch -> Hash) -> (Patch -> Patch) -> Patch -> Hash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Patch -> Patch
m2hPatch

hashBranch0 :: Memory.Branch.Branch0 m -> Hash
hashBranch0 :: forall (m :: * -> *). Branch0 m -> Hash
hashBranch0 = Branch -> Hash
forall a. ContentAddressable a => a -> Hash
Hashing.contentHash (Branch -> Hash) -> (Branch0 m -> Branch) -> Branch0 m -> Hash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Branch0 m -> Branch
forall (m :: * -> *). Branch0 m -> Branch
m2hBranch0

hashCausal :: (Hashing.ContentAddressable e) => e -> Set CausalHash -> (CausalHash, HashFor e)
hashCausal :: forall e.
ContentAddressable e =>
e -> Set CausalHash -> (CausalHash, HashFor e)
hashCausal e
e Set CausalHash
tails =
  let valueHash :: Hash
valueHash = e -> Hash
forall a. ContentAddressable a => a -> Hash
Hashing.contentHash e
e
      causalHash :: CausalHash
causalHash =
        Hash -> CausalHash
CausalHash (Hash -> CausalHash) -> (Causal -> Hash) -> Causal -> CausalHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Causal -> Hash
forall a. ContentAddressable a => a -> Hash
Hashing.contentHash (Causal -> CausalHash) -> Causal -> CausalHash
forall a b. (a -> b) -> a -> b
$
          Hash -> Set Hash -> Causal
Hashing.Causal Hash
valueHash ((CausalHash -> Hash) -> Set CausalHash -> Set Hash
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map CausalHash -> Hash
unCausalHash Set CausalHash
tails)
   in (CausalHash
causalHash, Hash -> HashFor e
forall t. Hash -> HashFor t
HashFor Hash
valueHash)

m2hBranch0 :: Memory.Branch.Branch0 m -> Hashing.Branch
m2hBranch0 :: forall (m :: * -> *). Branch0 m -> Branch
m2hBranch0 Branch0 m
b =
  Map NameSegment (Map Referent MdValues)
-> Map NameSegment (Map Reference MdValues)
-> Map NameSegment Hash
-> Map NameSegment Hash
-> Branch
Hashing.Branch
    (Star Referent NameSegment
-> Map NameSegment (Map Referent MdValues)
doTerms (Branch0 m
b Branch0 m
-> Getting
     (Star Referent NameSegment) (Branch0 m) (Star Referent NameSegment)
-> Star Referent NameSegment
forall s a. s -> Getting a s a -> a
^. Getting
  (Star Referent NameSegment) (Branch0 m) (Star Referent NameSegment)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Star Referent NameSegment -> f (Star Referent NameSegment))
-> Branch0 m -> f (Branch0 m)
Memory.Branch.terms))
    (Star Reference NameSegment
-> Map NameSegment (Map Reference MdValues)
doTypes (Branch0 m
b Branch0 m
-> Getting
     (Star Reference NameSegment)
     (Branch0 m)
     (Star Reference NameSegment)
-> Star Reference NameSegment
forall s a. s -> Getting a s a -> a
^. Getting
  (Star Reference NameSegment)
  (Branch0 m)
  (Star Reference NameSegment)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Star Reference NameSegment -> f (Star Reference NameSegment))
-> Branch0 m -> f (Branch0 m)
Memory.Branch.types))
    (Map NameSegment (PatchHash, m Patch) -> Map NameSegment Hash
forall (m :: * -> *).
Map NameSegment (PatchHash, m Patch) -> Map NameSegment Hash
doPatches (Branch0 m
b Branch0 m
-> Getting
     (Map NameSegment (PatchHash, m Patch))
     (Branch0 m)
     (Map NameSegment (PatchHash, m Patch))
-> Map NameSegment (PatchHash, m Patch)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map NameSegment (PatchHash, m Patch))
  (Branch0 m)
  (Map NameSegment (PatchHash, m Patch))
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Map NameSegment (PatchHash, m Patch)
 -> f (Map NameSegment (PatchHash, m Patch)))
-> Branch0 m -> f (Branch0 m)
Memory.Branch.edits))
    (Map NameSegment (Branch m) -> Map NameSegment Hash
forall (m :: * -> *).
Map NameSegment (Branch m) -> Map NameSegment Hash
doChildren (Branch0 m
b Branch0 m
-> Getting
     (Map NameSegment (Branch m))
     (Branch0 m)
     (Map NameSegment (Branch m))
-> Map NameSegment (Branch m)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map NameSegment (Branch m))
  (Branch0 m)
  (Map NameSegment (Branch m))
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Map NameSegment (Branch m) -> f (Map NameSegment (Branch m)))
-> Branch0 m -> f (Branch0 m)
Memory.Branch.children))
  where
    -- is there a more readable way to structure these that's also linear?
    doTerms ::
      Memory.Branch.Star Memory.Referent.Referent Memory.NameSegment ->
      Map Hashing.NameSegment (Map Hashing.Referent Hashing.MdValues)
    doTerms :: Star Referent NameSegment
-> Map NameSegment (Map Referent MdValues)
doTerms Star Referent NameSegment
s =
      [(NameSegment, Map Referent MdValues)]
-> Map NameSegment (Map Referent MdValues)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ (NameSegment -> NameSegment
m2hNameSegment NameSegment
ns, Map Referent MdValues
m2)
          | NameSegment
ns <- Set NameSegment -> [NameSegment]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Set NameSegment -> [NameSegment])
-> (Relation Referent NameSegment -> Set NameSegment)
-> Relation Referent NameSegment
-> [NameSegment]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation Referent NameSegment -> Set NameSegment
forall a b. Relation a b -> Set b
Relation.ran (Relation Referent NameSegment -> [NameSegment])
-> Relation Referent NameSegment -> [NameSegment]
forall a b. (a -> b) -> a -> b
$ Star Referent NameSegment -> Relation Referent NameSegment
forall fact d1 d2. Star2 fact d1 d2 -> Relation fact d1
Memory.Star2.d1 Star Referent NameSegment
s,
            let m2 :: Map Referent MdValues
m2 =
                  [(Referent, MdValues)] -> Map Referent MdValues
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                    [ ((Referent, Map Reference ConstructorType) -> Referent
forall a b. (a, b) -> a
fst (WriterT (Map Reference ConstructorType) Identity Referent
-> (Referent, Map Reference ConstructorType)
forall w a. Monoid w => Writer w a -> (a, w)
Writer.runWriter (Referent
-> WriterT (Map Reference ConstructorType) Identity Referent
m2hReferent Referent
r)), MdValues
md)
                      | Referent
r <- Set Referent -> [Referent]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Set Referent -> [Referent])
-> (Relation Referent NameSegment -> Set Referent)
-> Relation Referent NameSegment
-> [Referent]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSegment -> Relation Referent NameSegment -> Set Referent
forall b a. Ord b => b -> Relation a b -> Set a
Relation.lookupRan NameSegment
ns (Relation Referent NameSegment -> [Referent])
-> Relation Referent NameSegment -> [Referent]
forall a b. (a -> b) -> a -> b
$ Star Referent NameSegment -> Relation Referent NameSegment
forall fact d1 d2. Star2 fact d1 d2 -> Relation fact d1
Memory.Star2.d1 Star Referent NameSegment
s,
                        let md :: MdValues
md = Set Reference -> MdValues
Hashing.MdValues (Set Reference -> MdValues)
-> (Relation Referent Reference -> Set Reference)
-> Relation Referent Reference
-> MdValues
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Reference -> Reference) -> Set Reference -> Set Reference
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Reference -> Reference
m2hReference (Set Reference -> Set Reference)
-> (Relation Referent Reference -> Set Reference)
-> Relation Referent Reference
-> Set Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Referent -> Relation Referent Reference -> Set Reference
forall a b. Ord a => a -> Relation a b -> Set b
Relation.lookupDom Referent
r (Relation Referent Reference -> MdValues)
-> Relation Referent Reference -> MdValues
forall a b. (a -> b) -> a -> b
$ Star Referent NameSegment -> Relation Referent Reference
forall fact d1 d2. Star2 fact d1 d2 -> Relation fact d2
Memory.Star2.d2 Star Referent NameSegment
s
                    ]
        ]

    doTypes ::
      Memory.Branch.Star Memory.Reference.Reference Memory.NameSegment ->
      Map Hashing.NameSegment (Map Hashing.Reference Hashing.MdValues)
    doTypes :: Star Reference NameSegment
-> Map NameSegment (Map Reference MdValues)
doTypes Star Reference NameSegment
s =
      [(NameSegment, Map Reference MdValues)]
-> Map NameSegment (Map Reference MdValues)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ (NameSegment -> NameSegment
m2hNameSegment NameSegment
ns, Map Reference MdValues
m2)
          | NameSegment
ns <- Set NameSegment -> [NameSegment]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Set NameSegment -> [NameSegment])
-> (Relation Reference NameSegment -> Set NameSegment)
-> Relation Reference NameSegment
-> [NameSegment]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation Reference NameSegment -> Set NameSegment
forall a b. Relation a b -> Set b
Relation.ran (Relation Reference NameSegment -> [NameSegment])
-> Relation Reference NameSegment -> [NameSegment]
forall a b. (a -> b) -> a -> b
$ Star Reference NameSegment -> Relation Reference NameSegment
forall fact d1 d2. Star2 fact d1 d2 -> Relation fact d1
Memory.Star2.d1 Star Reference NameSegment
s,
            let m2 :: Map Reference MdValues
m2 =
                  [(Reference, MdValues)] -> Map Reference MdValues
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                    [ (Reference -> Reference
m2hReference Reference
r, MdValues
md)
                      | Reference
r <- Set Reference -> [Reference]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Set Reference -> [Reference])
-> (Relation Reference NameSegment -> Set Reference)
-> Relation Reference NameSegment
-> [Reference]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSegment -> Relation Reference NameSegment -> Set Reference
forall b a. Ord b => b -> Relation a b -> Set a
Relation.lookupRan NameSegment
ns (Relation Reference NameSegment -> [Reference])
-> Relation Reference NameSegment -> [Reference]
forall a b. (a -> b) -> a -> b
$ Star Reference NameSegment -> Relation Reference NameSegment
forall fact d1 d2. Star2 fact d1 d2 -> Relation fact d1
Memory.Star2.d1 Star Reference NameSegment
s,
                        let md :: Hashing.MdValues
                            md :: MdValues
md = Set Reference -> MdValues
Hashing.MdValues (Set Reference -> MdValues)
-> (Relation Reference Reference -> Set Reference)
-> Relation Reference Reference
-> MdValues
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Reference -> Reference) -> Set Reference -> Set Reference
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Reference -> Reference
m2hReference (Set Reference -> Set Reference)
-> (Relation Reference Reference -> Set Reference)
-> Relation Reference Reference
-> Set Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> Relation Reference Reference -> Set Reference
forall a b. Ord a => a -> Relation a b -> Set b
Relation.lookupDom Reference
r (Relation Reference Reference -> MdValues)
-> Relation Reference Reference -> MdValues
forall a b. (a -> b) -> a -> b
$ Star Reference NameSegment -> Relation Reference Reference
forall fact d1 d2. Star2 fact d1 d2 -> Relation fact d2
Memory.Star2.d2 Star Reference NameSegment
s
                    ]
        ]

    doPatches ::
      Map Memory.NameSegment.NameSegment (PatchHash, m Memory.Patch.Patch) ->
      Map Hashing.NameSegment Hash
    doPatches :: forall (m :: * -> *).
Map NameSegment (PatchHash, m Patch) -> Map NameSegment Hash
doPatches = (NameSegment -> NameSegment)
-> ((PatchHash, m Patch) -> Hash)
-> Map NameSegment (PatchHash, m Patch)
-> Map NameSegment Hash
forall a' a b b'.
Ord a' =>
(a -> a') -> (b -> b') -> Map a b -> Map a' b'
Map.bimap NameSegment -> NameSegment
m2hNameSegment (PatchHash -> Hash
unPatchHash (PatchHash -> Hash)
-> ((PatchHash, m Patch) -> PatchHash)
-> (PatchHash, m Patch)
-> Hash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PatchHash, m Patch) -> PatchHash
forall a b. (a, b) -> a
fst)

    doChildren ::
      Map Memory.NameSegment (Memory.Branch.Branch m) ->
      Map Hashing.NameSegment Hash
    doChildren :: forall (m :: * -> *).
Map NameSegment (Branch m) -> Map NameSegment Hash
doChildren = (NameSegment -> NameSegment)
-> (Branch m -> Hash)
-> Map NameSegment (Branch m)
-> Map NameSegment Hash
forall a' a b b'.
Ord a' =>
(a -> a') -> (b -> b') -> Map a b -> Map a' b'
Map.bimap NameSegment -> NameSegment
m2hNameSegment (CausalHash -> Hash
unCausalHash (CausalHash -> Hash)
-> (Branch m -> CausalHash) -> Branch m -> Hash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Branch m -> CausalHash
forall (m :: * -> *). Branch m -> CausalHash
Memory.Branch.headHash)

m2hNameSegment :: Memory.NameSegment -> Hashing.NameSegment
m2hNameSegment :: NameSegment -> NameSegment
m2hNameSegment =
  Text -> NameSegment
Hashing.NameSegment (Text -> NameSegment)
-> (NameSegment -> Text) -> NameSegment -> NameSegment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSegment -> Text
Memory.NameSegment.toUnescapedText