module Unison.Hashing.V2.DataDeclaration
  ( DataDeclaration (..),
    EffectDeclaration (..),
    Decl,
    Modifier (..),
    hashDecls,
  )
where

import Control.Lens (_3)
import Data.Map qualified as Map
import Unison.ABT qualified as ABT
import Unison.Hash (Hash)
import Unison.Hashing.V2.ABT qualified as ABT
import Unison.Hashing.V2.Reference (Reference (..), ReferenceId)
import Unison.Hashing.V2.Reference.Util qualified as Reference.Util
import Unison.Hashing.V2.Tokenizable (Hashable1)
import Unison.Hashing.V2.Tokenizable qualified as Hashable
import Unison.Hashing.V2.Type (Type, TypeF)
import Unison.Hashing.V2.Type qualified as Type
import Unison.Name qualified as Name
import Unison.Names.ResolutionResult qualified as Names
import Unison.Prelude
import Unison.Var (Var)
import Prelude hiding (cycle)

type Decl v a = Either (EffectDeclaration v a) (DataDeclaration v a)

data Modifier = Structural | Unique Text --  | Opaque (Set Reference)
  deriving (Modifier -> Modifier -> Bool
(Modifier -> Modifier -> Bool)
-> (Modifier -> Modifier -> Bool) -> Eq Modifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Modifier -> Modifier -> Bool
== :: Modifier -> Modifier -> Bool
$c/= :: Modifier -> Modifier -> Bool
/= :: Modifier -> Modifier -> Bool
Eq, Eq Modifier
Eq Modifier =>
(Modifier -> Modifier -> Ordering)
-> (Modifier -> Modifier -> Bool)
-> (Modifier -> Modifier -> Bool)
-> (Modifier -> Modifier -> Bool)
-> (Modifier -> Modifier -> Bool)
-> (Modifier -> Modifier -> Modifier)
-> (Modifier -> Modifier -> Modifier)
-> Ord Modifier
Modifier -> Modifier -> Bool
Modifier -> Modifier -> Ordering
Modifier -> Modifier -> Modifier
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Modifier -> Modifier -> Ordering
compare :: Modifier -> Modifier -> Ordering
$c< :: Modifier -> Modifier -> Bool
< :: Modifier -> Modifier -> Bool
$c<= :: Modifier -> Modifier -> Bool
<= :: Modifier -> Modifier -> Bool
$c> :: Modifier -> Modifier -> Bool
> :: Modifier -> Modifier -> Bool
$c>= :: Modifier -> Modifier -> Bool
>= :: Modifier -> Modifier -> Bool
$cmax :: Modifier -> Modifier -> Modifier
max :: Modifier -> Modifier -> Modifier
$cmin :: Modifier -> Modifier -> Modifier
min :: Modifier -> Modifier -> Modifier
Ord, Int -> Modifier -> ShowS
[Modifier] -> ShowS
Modifier -> String
(Int -> Modifier -> ShowS)
-> (Modifier -> String) -> ([Modifier] -> ShowS) -> Show Modifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Modifier -> ShowS
showsPrec :: Int -> Modifier -> ShowS
$cshow :: Modifier -> String
show :: Modifier -> String
$cshowList :: [Modifier] -> ShowS
showList :: [Modifier] -> ShowS
Show)

data DataDeclaration v a = DataDeclaration
  { forall v a. DataDeclaration v a -> Modifier
modifier :: Modifier,
    forall v a. DataDeclaration v a -> a
annotation :: a,
    forall v a. DataDeclaration v a -> [v]
bound :: [v],
    forall v a. DataDeclaration v a -> [(a, v, Type v a)]
constructors' :: [(a, v, Type v a)]
  }
  deriving ((forall a b.
 (a -> b) -> DataDeclaration v a -> DataDeclaration v b)
-> (forall a b. a -> DataDeclaration v b -> DataDeclaration v a)
-> Functor (DataDeclaration v)
forall a b. a -> DataDeclaration v b -> DataDeclaration v a
forall a b. (a -> b) -> DataDeclaration v a -> DataDeclaration v b
forall v a b. a -> DataDeclaration v b -> DataDeclaration v a
forall v a b.
(a -> b) -> DataDeclaration v a -> DataDeclaration v b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall v a b.
(a -> b) -> DataDeclaration v a -> DataDeclaration v b
fmap :: forall a b. (a -> b) -> DataDeclaration v a -> DataDeclaration v b
$c<$ :: forall v a b. a -> DataDeclaration v b -> DataDeclaration v a
<$ :: forall a b. a -> DataDeclaration v b -> DataDeclaration v a
Functor)

newtype EffectDeclaration v a = EffectDeclaration
  { forall v a. EffectDeclaration v a -> DataDeclaration v a
toDataDecl :: DataDeclaration v a
  }
  deriving ((forall a b.
 (a -> b) -> EffectDeclaration v a -> EffectDeclaration v b)
-> (forall a b.
    a -> EffectDeclaration v b -> EffectDeclaration v a)
-> Functor (EffectDeclaration v)
forall a b. a -> EffectDeclaration v b -> EffectDeclaration v a
forall a b.
(a -> b) -> EffectDeclaration v a -> EffectDeclaration v b
forall v a b. a -> EffectDeclaration v b -> EffectDeclaration v a
forall v a b.
(a -> b) -> EffectDeclaration v a -> EffectDeclaration v b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall v a b.
(a -> b) -> EffectDeclaration v a -> EffectDeclaration v b
fmap :: forall a b.
(a -> b) -> EffectDeclaration v a -> EffectDeclaration v b
$c<$ :: forall v a b. a -> EffectDeclaration v b -> EffectDeclaration v a
<$ :: forall a b. a -> EffectDeclaration v b -> EffectDeclaration v a
Functor)

constructorTypes :: DataDeclaration v a -> [Type v a]
constructorTypes :: forall v a. DataDeclaration v a -> [Type v a]
constructorTypes = ((v, Type v a) -> Type v a
forall a b. (a, b) -> b
snd ((v, Type v a) -> Type v a) -> [(v, Type v a)] -> [Type v a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([(v, Type v a)] -> [Type v a])
-> (DataDeclaration v a -> [(v, Type v a)])
-> DataDeclaration v a
-> [Type v a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataDeclaration v a -> [(v, Type v a)]
forall v a. DataDeclaration v a -> [(v, Type v a)]
constructors

constructors :: DataDeclaration v a -> [(v, Type v a)]
constructors :: forall v a. DataDeclaration v a -> [(v, Type v a)]
constructors (DataDeclaration Modifier
_ a
_ [v]
_ [(a, v, Type v a)]
ctors) = [(v
v, Type v a
t) | (a
_, v
v, Type v a
t) <- [(a, v, Type v a)]
ctors]

toABT :: (ABT.Var v) => DataDeclaration v () -> ABT.Term F v ()
toABT :: forall v. Var v => DataDeclaration v () -> Term F v ()
toABT DataDeclaration v ()
dd = F (Term F v ()) -> Term F v ()
forall (f :: * -> *) v.
(Foldable f, Ord v) =>
f (Term f v ()) -> Term f v ()
ABT.tm (F (Term F v ()) -> Term F v ()) -> F (Term F v ()) -> Term F v ()
forall a b. (a -> b) -> a -> b
$ Modifier -> Term F v () -> F (Term F v ())
forall a. Modifier -> a -> F a
Modified (DataDeclaration v () -> Modifier
forall v a. DataDeclaration v a -> Modifier
modifier DataDeclaration v ()
dd) Term F v ()
dd'
  where
    dd' :: Term F v ()
dd' = [v] -> Term F v () -> Term F v ()
forall v (f :: * -> *). Ord v => [v] -> Term f v () -> Term f v ()
ABT.absChain (DataDeclaration v () -> [v]
forall v a. DataDeclaration v a -> [v]
bound DataDeclaration v ()
dd) (F (Term F v ()) -> Term F v ()
forall (f :: * -> *) v.
(Foldable f, Ord v) =>
f (Term f v ()) -> Term f v ()
ABT.tm ([Term F v ()] -> F (Term F v ())
forall a. [a] -> F a
Constructors ((forall a1. TypeF a1 -> F a1) -> Term TypeF v () -> Term F v ()
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 TypeF a1 -> F a1
forall a1. TypeF a1 -> F a1
Type (Term TypeF v () -> Term F v ())
-> [Term TypeF v ()] -> [Term F v ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DataDeclaration v () -> [Term TypeF v ()]
forall v a. DataDeclaration v a -> [Type v a]
constructorTypes DataDeclaration v ()
dd)))

-- Implementation detail of `hashDecls`, works with unannotated data decls
hashDecls0 :: (Eq v, ABT.Var v, Show v) => Map v (DataDeclaration v ()) -> [(v, ReferenceId)]
hashDecls0 :: forall v.
(Eq v, Var v, Show v) =>
Map v (DataDeclaration v ()) -> [(v, ReferenceId)]
hashDecls0 Map v (DataDeclaration v ())
decls =
  let abts :: Map v (Term F v ())
abts = DataDeclaration v () -> Term F v ()
forall v. Var v => DataDeclaration v () -> Term F v ()
toABT (DataDeclaration v () -> Term F v ())
-> Map v (DataDeclaration v ()) -> Map v (Term F v ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map v (DataDeclaration v ())
decls
      ref :: ReferenceId -> Term F v ()
ref ReferenceId
r = F (Term F v ()) -> Term F v ()
forall (f :: * -> *) v.
(Foldable f, Ord v) =>
f (Term f v ()) -> Term f v ()
ABT.tm (TypeF (Term F v ()) -> F (Term F v ())
forall a1. TypeF a1 -> F a1
Type (Reference -> TypeF (Term F v ())
forall a. Reference -> TypeF a
Type.TypeRef (ReferenceId -> Reference
ReferenceDerivedId ReferenceId
r)))
      cs :: Map v (ReferenceId, Term F v ())
cs = (ReferenceId -> Term F v ())
-> Map v (Term F v ()) -> Map v (ReferenceId, Term F v ())
forall (f :: * -> *) v a.
(Functor f, Hashable1 f, Foldable f, Eq v, Show v, Var v) =>
(ReferenceId -> Term f v ())
-> Map v (Term f v a) -> Map v (ReferenceId, Term f v a)
Reference.Util.hashComponents ReferenceId -> Term F v ()
forall {v}. Ord v => ReferenceId -> Term F v ()
ref Map v (Term F v ())
abts
   in [(v
v, ReferenceId
r) | (v
v, (ReferenceId
r, Term F v ()
_)) <- Map v (ReferenceId, Term F v ())
-> [(v, (ReferenceId, Term F v ()))]
forall k a. Map k a -> [(k, a)]
Map.toList Map v (ReferenceId, Term F v ())
cs]

-- | compute the hashes of these user defined types and update any free vars
--   corresponding to these decls with the resulting hashes
--
--   data List a = Nil | Cons a (List a)
--   becomes something like
--   (List, #xyz, [forall a. #xyz a, forall a. a -> (#xyz a) -> (#xyz a)])
--
-- NOTE: technical limitation, this implementation gives diff results if ctors
-- have the same FQN as one of the types. TODO: assert this and bomb if not
-- satisfied, or else do local mangling and unmangling to ensure this doesn't
-- affect the hash.
hashDecls ::
  (Eq v, Var v, Show v) =>
  (v -> Name.Name) ->
  Map v (DataDeclaration v a) ->
  Names.ResolutionResult a [(v, ReferenceId, DataDeclaration v a)]
hashDecls :: forall v a.
(Eq v, Var v, Show v) =>
(v -> Name)
-> Map v (DataDeclaration v a)
-> ResolutionResult a [(v, ReferenceId, DataDeclaration v a)]
hashDecls v -> Name
unsafeVarToName Map v (DataDeclaration v a)
decls = do
  -- todo: make sure all other external references are resolved before calling this
  let varToRef :: [(v, ReferenceId)]
varToRef = Map v (DataDeclaration v ()) -> [(v, ReferenceId)]
forall v.
(Eq v, Var v, Show v) =>
Map v (DataDeclaration v ()) -> [(v, ReferenceId)]
hashDecls0 (DataDeclaration v a -> DataDeclaration v ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (DataDeclaration v a -> DataDeclaration v ())
-> Map v (DataDeclaration v a) -> Map v (DataDeclaration v ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map v (DataDeclaration v a)
decls)
      varToRef' :: [(v, Reference)]
varToRef' = (ReferenceId -> Reference) -> (v, ReferenceId) -> (v, Reference)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ReferenceId -> Reference
ReferenceDerivedId ((v, ReferenceId) -> (v, Reference))
-> [(v, ReferenceId)] -> [(v, Reference)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(v, ReferenceId)]
varToRef
      decls' :: Map v (DataDeclaration v a)
decls' = DataDeclaration v a -> DataDeclaration v a
forall {a}. DataDeclaration v a -> DataDeclaration v a
bindTypes (DataDeclaration v a -> DataDeclaration v a)
-> Map v (DataDeclaration v a) -> Map v (DataDeclaration v a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map v (DataDeclaration v a)
decls
      bindTypes :: DataDeclaration v a -> DataDeclaration v a
bindTypes DataDeclaration v a
dd = DataDeclaration v a
dd {constructors' = over _3 (Type.bindExternal varToRef') <$> constructors' dd}
      typeReferences :: Map Name Reference
typeReferences = [(Name, Reference)] -> Map Name Reference
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ((v -> Name) -> (v, Reference) -> (Name, Reference)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first v -> Name
unsafeVarToName ((v, Reference) -> (Name, Reference))
-> [(v, Reference)] -> [(Name, Reference)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(v, Reference)]
varToRef')
      -- normalize the order of the constructors based on a hash of their types
      sortCtors :: DataDeclaration v a -> DataDeclaration v a
sortCtors DataDeclaration v a
dd = DataDeclaration v a
dd {constructors' = sortOn hash3 $ constructors' dd}
      hash3 :: (a, b, Term f v a) -> Hash
hash3 (a
_, b
_, Term f v a
typ) = Term f v a -> Hash
forall (f :: * -> *) v a.
(Functor f, Hashable1 f, Eq v, Show v) =>
Term f v a -> Hash
ABT.hash Term f v a
typ :: Hash
  Map v (DataDeclaration v a)
decls' <- (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}.
(Eq v, Show v) =>
DataDeclaration v a -> DataDeclaration v a
sortCtors (Map v (DataDeclaration v a) -> Map v (DataDeclaration v a))
-> Either (Seq (ResolutionFailure a)) (Map v (DataDeclaration v a))
-> Either (Seq (ResolutionFailure a)) (Map v (DataDeclaration v a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DataDeclaration v a
 -> Either (Seq (ResolutionFailure a)) (DataDeclaration v a))
-> Map v (DataDeclaration v a)
-> Either (Seq (ResolutionFailure a)) (Map v (DataDeclaration 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 ((v -> Name)
-> Set v
-> Map Name Reference
-> DataDeclaration v a
-> Either (Seq (ResolutionFailure a)) (DataDeclaration v a)
forall v a.
Var v =>
(v -> Name)
-> Set v
-> Map Name Reference
-> DataDeclaration v a
-> ResolutionResult a (DataDeclaration v a)
bindReferences v -> Name
unsafeVarToName Set v
forall a. Monoid a => a
mempty Map Name Reference
typeReferences) Map v (DataDeclaration v a)
decls'
  pure [(v
v, ReferenceId
r, DataDeclaration v a
dd) | (v
v, ReferenceId
r) <- [(v, ReferenceId)]
varToRef, Just DataDeclaration v a
dd <- [v -> Map v (DataDeclaration v a) -> Maybe (DataDeclaration v a)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup v
v Map v (DataDeclaration v a)
decls']]

bindReferences ::
  (Var v) =>
  (v -> Name.Name) ->
  Set v ->
  Map Name.Name Reference ->
  DataDeclaration v a ->
  Names.ResolutionResult a (DataDeclaration v a)
bindReferences :: forall v a.
Var v =>
(v -> Name)
-> Set v
-> Map Name Reference
-> DataDeclaration v a
-> ResolutionResult a (DataDeclaration v a)
bindReferences v -> Name
unsafeVarToName Set v
keepFree Map Name Reference
names (DataDeclaration Modifier
m a
a [v]
bound [(a, v, Type v a)]
constructors) = do
  [(a, v, Type v a)]
constructors <- [(a, v, Type v a)]
-> ((a, v, Type v a)
    -> Either (Seq (ResolutionFailure a)) (a, v, Type v a))
-> Either (Seq (ResolutionFailure a)) [(a, v, Type v a)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [(a, v, Type v a)]
constructors (((a, v, Type v a)
  -> Either (Seq (ResolutionFailure a)) (a, v, Type v a))
 -> Either (Seq (ResolutionFailure a)) [(a, v, Type v a)])
-> ((a, v, Type v a)
    -> Either (Seq (ResolutionFailure a)) (a, v, Type v a))
-> Either (Seq (ResolutionFailure a)) [(a, v, Type v a)]
forall a b. (a -> b) -> a -> b
$ \(a
a, v
v, Type v a
ty) ->
    (a
a,v
v,) (Type v a -> (a, v, Type v a))
-> Either (Seq (ResolutionFailure a)) (Type v a)
-> Either (Seq (ResolutionFailure a)) (a, v, Type v a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (v -> Name)
-> Set v
-> Map Name Reference
-> Type v a
-> Either (Seq (ResolutionFailure a)) (Type v a)
forall v a.
Var v =>
(v -> Name)
-> Set v
-> Map Name Reference
-> Type v a
-> ResolutionResult a (Type v a)
Type.bindReferences v -> Name
unsafeVarToName Set v
keepFree Map Name Reference
names Type v a
ty
  pure $ 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
DataDeclaration Modifier
m a
a [v]
bound [(a, v, Type v a)]
constructors

data F a
  = Type (TypeF a)
  | LetRec [a] a
  | Constructors [a]
  | Modified Modifier a
  deriving ((forall a b. (a -> b) -> F a -> F b)
-> (forall a b. a -> F b -> F a) -> Functor F
forall a b. a -> F b -> F a
forall a b. (a -> b) -> F a -> F b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> F a -> F b
fmap :: forall a b. (a -> b) -> F a -> F b
$c<$ :: forall a b. a -> F b -> F a
<$ :: forall a b. a -> F b -> F a
Functor, (forall m. Monoid m => F m -> m)
-> (forall m a. Monoid m => (a -> m) -> F a -> m)
-> (forall m a. Monoid m => (a -> m) -> F a -> m)
-> (forall a b. (a -> b -> b) -> b -> F a -> b)
-> (forall a b. (a -> b -> b) -> b -> F a -> b)
-> (forall b a. (b -> a -> b) -> b -> F a -> b)
-> (forall b a. (b -> a -> b) -> b -> F a -> b)
-> (forall a. (a -> a -> a) -> F a -> a)
-> (forall a. (a -> a -> a) -> F a -> a)
-> (forall a. F a -> [a])
-> (forall a. F a -> Bool)
-> (forall a. F a -> Int)
-> (forall a. Eq a => a -> F a -> Bool)
-> (forall a. Ord a => F a -> a)
-> (forall a. Ord a => F a -> a)
-> (forall a. Num a => F a -> a)
-> (forall a. Num a => F a -> a)
-> Foldable F
forall a. Eq a => a -> F a -> Bool
forall a. Num a => F a -> a
forall a. Ord a => F a -> a
forall m. Monoid m => F m -> m
forall a. F a -> Bool
forall a. F a -> Int
forall a. F a -> [a]
forall a. (a -> a -> a) -> F a -> a
forall m a. Monoid m => (a -> m) -> F a -> m
forall b a. (b -> a -> b) -> b -> F a -> b
forall a b. (a -> b -> b) -> b -> F a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => F m -> m
fold :: forall m. Monoid m => F m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> F a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> F a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> F a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> F a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> F a -> b
foldr :: forall a b. (a -> b -> b) -> b -> F a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> F a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> F a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> F a -> b
foldl :: forall b a. (b -> a -> b) -> b -> F a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> F a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> F a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> F a -> a
foldr1 :: forall a. (a -> a -> a) -> F a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> F a -> a
foldl1 :: forall a. (a -> a -> a) -> F a -> a
$ctoList :: forall a. F a -> [a]
toList :: forall a. F a -> [a]
$cnull :: forall a. F a -> Bool
null :: forall a. F a -> Bool
$clength :: forall a. F a -> Int
length :: forall a. F a -> Int
$celem :: forall a. Eq a => a -> F a -> Bool
elem :: forall a. Eq a => a -> F a -> Bool
$cmaximum :: forall a. Ord a => F a -> a
maximum :: forall a. Ord a => F a -> a
$cminimum :: forall a. Ord a => F a -> a
minimum :: forall a. Ord a => F a -> a
$csum :: forall a. Num a => F a -> a
sum :: forall a. Num a => F a -> a
$cproduct :: forall a. Num a => F a -> a
product :: forall a. Num a => F a -> a
Foldable)

instance Hashable1 F where
  hash1 :: forall a.
([a] -> ([Hash], a -> Hash)) -> (a -> Hash) -> F a -> Hash
hash1 [a] -> ([Hash], a -> Hash)
hashCycle a -> Hash
hash F a
e =
    let (Word8 -> Token
tag, Hash -> Token
hashed) = (Word8 -> Token
Hashable.Tag, Hash -> Token
Hashable.Hashed)
     in -- Note: start each layer with leading `2` byte, to avoid collisions with
        -- terms, which start each layer with leading `1`. See `Hashable1 Term.F`
        [Token] -> Hash
Hashable.accumulate ([Token] -> Hash) -> [Token] -> Hash
forall a b. (a -> b) -> a -> b
$
          Word8 -> Token
tag Word8
2 Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: case F a
e of
            Type TypeF a
t -> [Word8 -> Token
tag Word8
0, Hash -> Token
hashed (Hash -> Token) -> Hash -> Token
forall a b. (a -> b) -> a -> b
$ ([a] -> ([Hash], a -> Hash)) -> (a -> Hash) -> TypeF a -> Hash
forall a.
([a] -> ([Hash], a -> Hash)) -> (a -> Hash) -> TypeF a -> Hash
forall (f :: * -> *) a.
Hashable1 f =>
([a] -> ([Hash], a -> Hash)) -> (a -> Hash) -> f a -> Hash
Hashable.hash1 [a] -> ([Hash], a -> Hash)
hashCycle a -> Hash
hash TypeF a
t]
            LetRec [a]
bindings a
body ->
              let ([Hash]
hashes, a -> Hash
hash') = [a] -> ([Hash], a -> Hash)
hashCycle [a]
bindings
               in [Word8 -> Token
tag Word8
1] [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ (Hash -> Token) -> [Hash] -> [Token]
forall a b. (a -> b) -> [a] -> [b]
map Hash -> Token
hashed [Hash]
hashes [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ [Hash -> Token
hashed (Hash -> Token) -> Hash -> Token
forall a b. (a -> b) -> a -> b
$ a -> Hash
hash' a
body]
            Constructors [a]
cs ->
              let ([Hash]
hashes, a -> Hash
_) = [a] -> ([Hash], a -> Hash)
hashCycle [a]
cs
               in Word8 -> Token
tag Word8
2 Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: (Hash -> Token) -> [Hash] -> [Token]
forall a b. (a -> b) -> [a] -> [b]
map Hash -> Token
hashed [Hash]
hashes
            Modified Modifier
m a
t ->
              [Word8 -> Token
tag Word8
3, Modifier -> Token
forall t. Tokenizable t => t -> Token
Hashable.accumulateToken Modifier
m, Hash -> Token
hashed (Hash -> Token) -> Hash -> Token
forall a b. (a -> b) -> a -> b
$ a -> Hash
hash a
t]

instance Hashable.Tokenizable Modifier where
  tokens :: Modifier -> [Token]
tokens Modifier
Structural = [Word8 -> Token
Hashable.Tag Word8
0]
  tokens (Unique Text
txt) = [Word8 -> Token
Hashable.Tag Word8
1, Text -> Token
Hashable.Text Text
txt]