module U.Codebase.Decl where

import Control.Lens hiding (List)
import Control.Monad.State
import Data.Map qualified as Map
import Data.Set qualified as Set
import U.Codebase.Reference (Reference')
import U.Codebase.Reference qualified as Reference
import U.Codebase.Type (TypeR)
import U.Codebase.Type qualified as Type
import U.Core.ABT qualified as ABT
import U.Core.ABT.Var qualified as ABT
import Unison.Hash (Hash)
import Unison.Prelude
import Unison.Util.Recursion

type ConstructorId = Word64

data DeclType = Data | Effect
  deriving (DeclType -> DeclType -> Bool
(DeclType -> DeclType -> Bool)
-> (DeclType -> DeclType -> Bool) -> Eq DeclType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeclType -> DeclType -> Bool
== :: DeclType -> DeclType -> Bool
$c/= :: DeclType -> DeclType -> Bool
/= :: DeclType -> DeclType -> Bool
Eq, Eq DeclType
Eq DeclType =>
(DeclType -> DeclType -> Ordering)
-> (DeclType -> DeclType -> Bool)
-> (DeclType -> DeclType -> Bool)
-> (DeclType -> DeclType -> Bool)
-> (DeclType -> DeclType -> Bool)
-> (DeclType -> DeclType -> DeclType)
-> (DeclType -> DeclType -> DeclType)
-> Ord DeclType
DeclType -> DeclType -> Bool
DeclType -> DeclType -> Ordering
DeclType -> DeclType -> DeclType
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 :: DeclType -> DeclType -> Ordering
compare :: DeclType -> DeclType -> Ordering
$c< :: DeclType -> DeclType -> Bool
< :: DeclType -> DeclType -> Bool
$c<= :: DeclType -> DeclType -> Bool
<= :: DeclType -> DeclType -> Bool
$c> :: DeclType -> DeclType -> Bool
> :: DeclType -> DeclType -> Bool
$c>= :: DeclType -> DeclType -> Bool
>= :: DeclType -> DeclType -> Bool
$cmax :: DeclType -> DeclType -> DeclType
max :: DeclType -> DeclType -> DeclType
$cmin :: DeclType -> DeclType -> DeclType
min :: DeclType -> DeclType -> DeclType
Ord, Int -> DeclType -> ShowS
[DeclType] -> ShowS
DeclType -> String
(Int -> DeclType -> ShowS)
-> (DeclType -> String) -> ([DeclType] -> ShowS) -> Show DeclType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeclType -> ShowS
showsPrec :: Int -> DeclType -> ShowS
$cshow :: DeclType -> String
show :: DeclType -> String
$cshowList :: [DeclType] -> ShowS
showList :: [DeclType] -> ShowS
Show, Int -> DeclType
DeclType -> Int
DeclType -> [DeclType]
DeclType -> DeclType
DeclType -> DeclType -> [DeclType]
DeclType -> DeclType -> DeclType -> [DeclType]
(DeclType -> DeclType)
-> (DeclType -> DeclType)
-> (Int -> DeclType)
-> (DeclType -> Int)
-> (DeclType -> [DeclType])
-> (DeclType -> DeclType -> [DeclType])
-> (DeclType -> DeclType -> [DeclType])
-> (DeclType -> DeclType -> DeclType -> [DeclType])
-> Enum DeclType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: DeclType -> DeclType
succ :: DeclType -> DeclType
$cpred :: DeclType -> DeclType
pred :: DeclType -> DeclType
$ctoEnum :: Int -> DeclType
toEnum :: Int -> DeclType
$cfromEnum :: DeclType -> Int
fromEnum :: DeclType -> Int
$cenumFrom :: DeclType -> [DeclType]
enumFrom :: DeclType -> [DeclType]
$cenumFromThen :: DeclType -> DeclType -> [DeclType]
enumFromThen :: DeclType -> DeclType -> [DeclType]
$cenumFromTo :: DeclType -> DeclType -> [DeclType]
enumFromTo :: DeclType -> DeclType -> [DeclType]
$cenumFromThenTo :: DeclType -> DeclType -> DeclType -> [DeclType]
enumFromThenTo :: DeclType -> DeclType -> DeclType -> [DeclType]
Enum)

type Decl v = DeclR TypeRef v

type HashableDecl v = DeclR HashableTypeRef v

type TypeRef = Reference' Text (Maybe Hash)

type HashableTypeRef = Reference' Text Hash

type Type v = TypeR TypeRef v

type HashableType v = TypeR HashableTypeRef v

data Modifier = Structural | Unique Text
  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 DeclR r v = DataDeclaration
  { forall r v. DeclR r v -> DeclType
declType :: DeclType,
    forall r v. DeclR r v -> Modifier
modifier :: Modifier,
    forall r v. DeclR r v -> [v]
bound :: [v],
    forall r v. DeclR r v -> [TypeR r v]
constructorTypes :: [TypeR r v]
  }
  deriving (Int -> DeclR r v -> ShowS
[DeclR r v] -> ShowS
DeclR r v -> String
(Int -> DeclR r v -> ShowS)
-> (DeclR r v -> String)
-> ([DeclR r v] -> ShowS)
-> Show (DeclR r v)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall r v. (Show v, Show r) => Int -> DeclR r v -> ShowS
forall r v. (Show v, Show r) => [DeclR r v] -> ShowS
forall r v. (Show v, Show r) => DeclR r v -> String
$cshowsPrec :: forall r v. (Show v, Show r) => Int -> DeclR r v -> ShowS
showsPrec :: Int -> DeclR r v -> ShowS
$cshow :: forall r v. (Show v, Show r) => DeclR r v -> String
show :: DeclR r v -> String
$cshowList :: forall r v. (Show v, Show r) => [DeclR r v] -> ShowS
showList :: [DeclR r v] -> ShowS
Show)

allVars :: (Ord v) => DeclR r v -> Set v
allVars :: forall v r. Ord v => DeclR r v -> Set v
allVars (DataDeclaration DeclType
_ Modifier
_ [v]
bound [TypeR r v]
constructorTypes) =
  ([v] -> Set v
forall a. Ord a => [a] -> Set a
Set.fromList ([v] -> Set v) -> [v] -> Set v
forall a b. (a -> b) -> a -> b
$ (TypeR r v -> [v]) -> [TypeR r v] -> [v]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap TypeR r v -> [v]
forall (f :: * -> *) v a. Foldable f => Term f v a -> [v]
ABT.allVars [TypeR r v]
constructorTypes) Set v -> Set v -> Set v
forall a. Semigroup a => a -> a -> a
<> [v] -> Set v
forall a. Ord a => [a] -> Set a
Set.fromList [v]
bound

vmap :: (Ord v') => (v -> v') -> DeclR r v -> DeclR r v'
vmap :: forall v' v r. Ord v' => (v -> v') -> DeclR r v -> DeclR r v'
vmap v -> v'
f (DataDeclaration {DeclType
$sel:declType:DataDeclaration :: forall r v. DeclR r v -> DeclType
declType :: DeclType
declType, Modifier
$sel:modifier:DataDeclaration :: forall r v. DeclR r v -> Modifier
modifier :: Modifier
modifier, [v]
$sel:bound:DataDeclaration :: forall r v. DeclR r v -> [v]
bound :: [v]
bound, [TypeR r v]
$sel:constructorTypes:DataDeclaration :: forall r v. DeclR r v -> [TypeR r v]
constructorTypes :: [TypeR r v]
constructorTypes}) =
  DataDeclaration
    { DeclType
$sel:declType:DataDeclaration :: DeclType
declType :: DeclType
declType,
      Modifier
$sel:modifier:DataDeclaration :: Modifier
modifier :: Modifier
modifier,
      $sel:bound:DataDeclaration :: [v']
bound = v -> v'
f (v -> v') -> [v] -> [v']
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v]
bound,
      $sel:constructorTypes:DataDeclaration :: [TypeR r v']
constructorTypes = (v -> v') -> TypeR r v -> TypeR r v'
forall (f :: * -> *) v' v a.
(Functor f, Foldable f, Ord v') =>
(v -> v') -> Term f v a -> Term f v' a
ABT.vmap v -> v'
f (TypeR r v -> TypeR r v') -> [TypeR r v] -> [TypeR r v']
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeR r v]
constructorTypes
    }

rmap :: (Ord v) => (r -> r') -> DeclR r v -> DeclR r' v
rmap :: forall v r r'. Ord v => (r -> r') -> DeclR r v -> DeclR r' v
rmap r -> r'
f (DataDeclaration {DeclType
$sel:declType:DataDeclaration :: forall r v. DeclR r v -> DeclType
declType :: DeclType
declType, Modifier
$sel:modifier:DataDeclaration :: forall r v. DeclR r v -> Modifier
modifier :: Modifier
modifier, [v]
$sel:bound:DataDeclaration :: forall r v. DeclR r v -> [v]
bound :: [v]
bound, [TypeR r v]
$sel:constructorTypes:DataDeclaration :: forall r v. DeclR r v -> [TypeR r v]
constructorTypes :: [TypeR r v]
constructorTypes}) =
  DataDeclaration
    { DeclType
$sel:declType:DataDeclaration :: DeclType
declType :: DeclType
declType,
      Modifier
$sel:modifier:DataDeclaration :: Modifier
modifier :: Modifier
modifier,
      [v]
$sel:bound:DataDeclaration :: [v]
bound :: [v]
bound,
      $sel:constructorTypes:DataDeclaration :: [TypeR r' v]
constructorTypes = (r -> r') -> TypeR r v -> TypeR r' v
forall v r r' a.
Ord v =>
(r -> r') -> Term (F' r) v a -> Term (F' r') v a
Type.rmap r -> r'
f (TypeR r v -> TypeR r' v) -> [TypeR r v] -> [TypeR r' v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeR r v]
constructorTypes
    }

-- * Hashing stuff

dependencies :: (Ord r, Ord v) => DeclR r v -> Set r
dependencies :: forall r v. (Ord r, Ord v) => DeclR r v -> Set r
dependencies (DataDeclaration DeclType
_ Modifier
_ [v]
_ [TypeR r v]
cts) = (TypeR r v -> Set r) -> [TypeR r v] -> Set r
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap TypeR r v -> Set r
forall v r a. (Ord v, Ord r) => Term (F' r) v a -> Set r
Type.dependencies [TypeR r v]
cts

data V v = Bound v | Ctor Int

data F a
  = Type (Type.FD a)
  | LetRec [a] a
  | Constructors [a]
  | Modified DeclType 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, Int -> F a -> ShowS
[F a] -> ShowS
F a -> String
(Int -> F a -> ShowS)
-> (F a -> String) -> ([F a] -> ShowS) -> Show (F a)
forall a. Show a => Int -> F a -> ShowS
forall a. Show a => [F a] -> ShowS
forall a. Show a => F a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> F a -> ShowS
showsPrec :: Int -> F a -> ShowS
$cshow :: forall a. Show a => F a -> String
show :: F a -> String
$cshowList :: forall a. Show a => [F a] -> ShowS
showList :: [F a] -> ShowS
Show)

-- | Given the pieces of a single decl component,
-- replaces all 'Nothing' self-referential hashes with a variable reference
-- to the relevant piece of the component in the component map.
unhashComponent ::
  forall v extra.
  (ABT.Var v) =>
  Hash ->
  -- | A function to convert a reference to a variable. The actual var names aren't important.
  (Reference.Id -> v) ->
  -- A SINGLE decl component. Self references should have a 'Nothing' hash in term
  -- references/term links
  Map Reference.Id (Decl v, extra) ->
  -- | The component with all self-references replaced with variable references.
  Map Reference.Id (v, HashableDecl v, extra)
unhashComponent :: forall v extra.
Var v =>
Hash
-> (Id -> v)
-> Map Id (Decl v, extra)
-> Map Id (v, HashableDecl v, extra)
unhashComponent Hash
componentHash Id -> v
refToVar Map Id (Decl v, extra)
m =
  Map Id (v, Decl v, extra)
withGeneratedVars
    Map Id (v, Decl v, extra)
-> (Map Id (v, Decl v, extra) -> Map Id (v, HashableDecl v, extra))
-> Map Id (v, HashableDecl v, extra)
forall a b. a -> (a -> b) -> b
& ((v, Decl v, extra) -> Identity (v, HashableDecl v, extra))
-> Map Id (v, Decl v, extra)
-> Identity (Map Id (v, HashableDecl v, extra))
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
IndexedTraversal
  Int
  (Map Id (v, Decl v, extra))
  (Map Id (v, HashableDecl v, extra))
  (v, Decl v, extra)
  (v, HashableDecl v, extra)
traversed (((v, Decl v, extra) -> Identity (v, HashableDecl v, extra))
 -> Map Id (v, Decl v, extra)
 -> Identity (Map Id (v, HashableDecl v, extra)))
-> ((Decl v -> Identity (HashableDecl v))
    -> (v, Decl v, extra) -> Identity (v, HashableDecl v, extra))
-> (Decl v -> Identity (HashableDecl v))
-> Map Id (v, Decl v, extra)
-> Identity (Map Id (v, HashableDecl v, extra))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Decl v -> Identity (HashableDecl v))
-> (v, Decl v, extra) -> Identity (v, HashableDecl v, extra)
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (v, Decl v, extra)
  (v, HashableDecl v, extra)
  (Decl v)
  (HashableDecl v)
_2 ((Decl v -> Identity (HashableDecl v))
 -> Map Id (v, Decl v, extra)
 -> Identity (Map Id (v, HashableDecl v, extra)))
-> (Decl v -> HashableDecl v)
-> Map Id (v, Decl v, extra)
-> Map Id (v, HashableDecl v, extra)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Decl v -> HashableDecl v
fillSelfReferences
  where
    usedVars :: Set v
    usedVars :: Set v
usedVars = Getting (Set v) (Map Id (Decl v, extra)) (Decl v)
-> (Decl v -> Set v) -> Map Id (Decl v, extra) -> Set v
forall r s a. Getting r s a -> (a -> r) -> s -> r
foldMapOf (((Decl v, extra) -> Const (Set v) (Decl v, extra))
-> Map Id (Decl v, extra) -> Const (Set v) (Map Id (Decl v, extra))
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold Int (Map Id (Decl v, extra)) (Decl v, extra)
folded (((Decl v, extra) -> Const (Set v) (Decl v, extra))
 -> Map Id (Decl v, extra)
 -> Const (Set v) (Map Id (Decl v, extra)))
-> ((Decl v -> Const (Set v) (Decl v))
    -> (Decl v, extra) -> Const (Set v) (Decl v, extra))
-> Getting (Set v) (Map Id (Decl v, extra)) (Decl v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Decl v -> Const (Set v) (Decl v))
-> (Decl v, extra) -> Const (Set v) (Decl v, extra)
forall s t a b. Field1 s t a b => Lens s t a b
Lens (Decl v, extra) (Decl v, extra) (Decl v) (Decl v)
_1) Decl v -> Set v
forall v r. Ord v => DeclR r v -> Set v
allVars Map Id (Decl v, extra)
m
    withGeneratedVars :: Map Reference.Id (v, Decl v, extra)
    withGeneratedVars :: Map Id (v, Decl v, extra)
withGeneratedVars = State (Set v) (Map Id (v, Decl v, extra))
-> Set v -> Map Id (v, Decl v, extra)
forall s a. State s a -> s -> a
evalState ((Id
 -> (Decl v, extra) -> StateT (Set v) Identity (v, Decl v, extra))
-> Map Id (Decl v, extra)
-> State (Set v) (Map Id (v, Decl v, extra))
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
Map.traverseWithKey Id -> (Decl v, extra) -> StateT (Set v) Identity (v, Decl v, extra)
forall trm.
Id -> (trm, extra) -> StateT (Set v) Identity (v, trm, extra)
assignVar Map Id (Decl v, extra)
m) Set v
usedVars
    assignVar :: Reference.Id -> (trm, extra) -> StateT (Set v) Identity (v, trm, extra)
    assignVar :: forall trm.
Id -> (trm, extra) -> StateT (Set v) Identity (v, trm, extra)
assignVar Id
r (trm
trm, extra
extra) = (,trm
trm,extra
extra) (v -> (v, trm, extra))
-> StateT (Set v) Identity v
-> StateT (Set v) Identity (v, trm, extra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> v -> StateT (Set v) Identity v
forall v (m :: * -> *). (Var v, MonadState (Set v) m) => v -> m v
ABT.freshenS (Id -> v
refToVar Id
r)
    fillSelfReferences :: Decl v -> HashableDecl v
    fillSelfReferences :: Decl v -> HashableDecl v
fillSelfReferences DataDeclaration {DeclType
$sel:declType:DataDeclaration :: forall r v. DeclR r v -> DeclType
declType :: DeclType
declType, Modifier
$sel:modifier:DataDeclaration :: forall r v. DeclR r v -> Modifier
modifier :: Modifier
modifier, [v]
$sel:bound:DataDeclaration :: forall r v. DeclR r v -> [v]
bound :: [v]
bound, [TypeR (Reference' Text (Maybe Hash)) v]
$sel:constructorTypes:DataDeclaration :: forall r v. DeclR r v -> [TypeR r v]
constructorTypes :: [TypeR (Reference' Text (Maybe Hash)) v]
constructorTypes} =
      DataDeclaration
        { DeclType
$sel:declType:DataDeclaration :: DeclType
declType :: DeclType
declType,
          Modifier
$sel:modifier:DataDeclaration :: Modifier
modifier :: Modifier
modifier,
          [v]
$sel:bound:DataDeclaration :: [v]
bound :: [v]
bound,
          $sel:constructorTypes:DataDeclaration :: [TypeR HashableTypeRef v]
constructorTypes = Algebra
  (Term' (F' (Reference' Text (Maybe Hash))) v ())
  (TypeR HashableTypeRef v)
-> TypeR (Reference' Text (Maybe Hash)) v
-> TypeR HashableTypeRef v
forall a.
Algebra (Term' (F' (Reference' Text (Maybe Hash))) v ()) a
-> TypeR (Reference' Text (Maybe Hash)) v -> a
forall t (f :: * -> *) a. Recursive t f => Algebra f a -> t -> a
cata Algebra
  (Term' (F' (Reference' Text (Maybe Hash))) v ())
  (TypeR HashableTypeRef v)
alg (TypeR (Reference' Text (Maybe Hash)) v -> TypeR HashableTypeRef v)
-> [TypeR (Reference' Text (Maybe Hash)) v]
-> [TypeR HashableTypeRef v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeR (Reference' Text (Maybe Hash)) v]
constructorTypes
        }
      where
        rewriteTypeReference :: Reference.Id' (Maybe Hash) -> Either v Reference.Reference
        rewriteTypeReference :: Id' (Maybe Hash) -> Either v HashableTypeRef
rewriteTypeReference rid :: Id' (Maybe Hash)
rid@(Reference.Id Maybe Hash
mayH Pos
pos) =
          case Maybe Hash
mayH of
            Just Hash
h ->
              case Id -> Map Id (v, Decl v, extra) -> Maybe (v, Decl v, extra)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Hash -> Pos -> Id
forall h. h -> Pos -> Id' h
Reference.Id Hash
h Pos
pos) Map Id (v, Decl v, extra)
withGeneratedVars of
                -- No entry in the component map, so this is NOT a self-reference, keep it but
                -- replace the 'Maybe Hash' with a 'Hash'.
                Maybe (v, Decl v, extra)
Nothing -> HashableTypeRef -> Either v HashableTypeRef
forall a b. b -> Either a b
Right (Id -> HashableTypeRef
forall t h. Id' h -> Reference' t h
Reference.ReferenceDerived (Hash -> Pos -> Id
forall h. h -> Pos -> Id' h
Reference.Id Hash
h Pos
pos))
                -- Entry in the component map, so this is a self-reference, replace it with a
                -- Var.
                Just (v
v, Decl v
_, extra
_) -> v -> Either v HashableTypeRef
forall a b. a -> Either a b
Left v
v
            Maybe Hash
Nothing ->
              -- This is a self-reference, so we expect to find it in the component map.
              case Id -> Map Id (v, Decl v, extra) -> Maybe (v, Decl v, extra)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Hash -> Maybe Hash -> Hash
forall a. a -> Maybe a -> a
fromMaybe Hash
componentHash (Maybe Hash -> Hash) -> Id' (Maybe Hash) -> Id
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Id' (Maybe Hash)
rid) Map Id (v, Decl v, extra)
withGeneratedVars of
                Maybe (v, Decl v, extra)
Nothing -> String -> Either v HashableTypeRef
forall a. HasCallStack => String -> a
error String
"unhashComponent: self-reference not found in component map"
                Just (v
v, Decl v
_, extra
_) -> v -> Either v HashableTypeRef
forall a b. a -> Either a b
Left v
v
        alg :: ABT.Term' (Type.F' TypeRef) v () (HashableType v) -> HashableType v
        alg :: Algebra
  (Term' (F' (Reference' Text (Maybe Hash))) v ())
  (TypeR HashableTypeRef v)
alg (ABT.Term' Set v
_ () ABT (F' (Reference' Text (Maybe Hash))) v (TypeR HashableTypeRef v)
abt) = case ABT (F' (Reference' Text (Maybe Hash))) v (TypeR HashableTypeRef v)
abt of
          ABT.Var v
v -> () -> v -> TypeR HashableTypeRef v
forall a v (f :: * -> *). a -> v -> Term f v a
ABT.var () v
v
          ABT.Cycle TypeR HashableTypeRef v
body -> () -> TypeR HashableTypeRef v -> TypeR HashableTypeRef v
forall a (f :: * -> *) v. a -> Term f v a -> Term f v a
ABT.cycle () TypeR HashableTypeRef v
body
          ABT.Abs v
v TypeR HashableTypeRef v
body -> () -> v -> TypeR HashableTypeRef v -> TypeR HashableTypeRef v
forall v a (f :: * -> *).
Ord v =>
a -> v -> Term f v a -> Term f v a
ABT.abs () v
v TypeR HashableTypeRef v
body
          ABT.Tm F' (Reference' Text (Maybe Hash)) (TypeR HashableTypeRef v)
t -> case F' (Reference' Text (Maybe Hash)) (TypeR HashableTypeRef v)
t of
            Type.Ref (Reference.ReferenceDerived Id' (Maybe Hash)
rid) ->
              Id' (Maybe Hash) -> Either v HashableTypeRef
rewriteTypeReference Id' (Maybe Hash)
rid
                Either v HashableTypeRef
-> (Either v HashableTypeRef -> TypeR HashableTypeRef v)
-> TypeR HashableTypeRef v
forall a b. a -> (a -> b) -> b
& (v -> TypeR HashableTypeRef v)
-> (HashableTypeRef -> TypeR HashableTypeRef v)
-> Either v HashableTypeRef
-> TypeR HashableTypeRef v
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (() -> v -> TypeR HashableTypeRef v
forall a v (f :: * -> *). a -> v -> Term f v a
ABT.var ()) (()
-> F' HashableTypeRef (TypeR HashableTypeRef v)
-> TypeR HashableTypeRef v
forall (f :: * -> *) v a.
(Foldable f, Ord v) =>
a -> f (Term f v a) -> Term f v a
ABT.tm () (F' HashableTypeRef (TypeR HashableTypeRef v)
 -> TypeR HashableTypeRef v)
-> (HashableTypeRef
    -> F' HashableTypeRef (TypeR HashableTypeRef v))
-> HashableTypeRef
-> TypeR HashableTypeRef v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashableTypeRef -> F' HashableTypeRef (TypeR HashableTypeRef v)
forall r a. r -> F' r a
Type.Ref)
            Type.Ref (Reference.ReferenceBuiltin Text
t) ->
              ()
-> F' HashableTypeRef (TypeR HashableTypeRef v)
-> TypeR HashableTypeRef v
forall (f :: * -> *) v a.
(Foldable f, Ord v) =>
a -> f (Term f v a) -> Term f v a
ABT.tm () (F' HashableTypeRef (TypeR HashableTypeRef v)
 -> TypeR HashableTypeRef v)
-> F' HashableTypeRef (TypeR HashableTypeRef v)
-> TypeR HashableTypeRef v
forall a b. (a -> b) -> a -> b
$ HashableTypeRef -> F' HashableTypeRef (TypeR HashableTypeRef v)
forall r a. r -> F' r a
Type.Ref (Text -> HashableTypeRef
forall t h. t -> Reference' t h
Reference.ReferenceBuiltin Text
t)
            Type.Arrow TypeR HashableTypeRef v
a TypeR HashableTypeRef v
b -> ()
-> F' HashableTypeRef (TypeR HashableTypeRef v)
-> TypeR HashableTypeRef v
forall (f :: * -> *) v a.
(Foldable f, Ord v) =>
a -> f (Term f v a) -> Term f v a
ABT.tm () (F' HashableTypeRef (TypeR HashableTypeRef v)
 -> TypeR HashableTypeRef v)
-> F' HashableTypeRef (TypeR HashableTypeRef v)
-> TypeR HashableTypeRef v
forall a b. (a -> b) -> a -> b
$ TypeR HashableTypeRef v
-> TypeR HashableTypeRef v
-> F' HashableTypeRef (TypeR HashableTypeRef v)
forall r a. a -> a -> F' r a
Type.Arrow TypeR HashableTypeRef v
a TypeR HashableTypeRef v
b
            Type.Ann TypeR HashableTypeRef v
a Kind
k -> ()
-> F' HashableTypeRef (TypeR HashableTypeRef v)
-> TypeR HashableTypeRef v
forall (f :: * -> *) v a.
(Foldable f, Ord v) =>
a -> f (Term f v a) -> Term f v a
ABT.tm () (F' HashableTypeRef (TypeR HashableTypeRef v)
 -> TypeR HashableTypeRef v)
-> F' HashableTypeRef (TypeR HashableTypeRef v)
-> TypeR HashableTypeRef v
forall a b. (a -> b) -> a -> b
$ TypeR HashableTypeRef v
-> Kind -> F' HashableTypeRef (TypeR HashableTypeRef v)
forall r a. a -> Kind -> F' r a
Type.Ann TypeR HashableTypeRef v
a Kind
k
            Type.App TypeR HashableTypeRef v
a TypeR HashableTypeRef v
b -> ()
-> F' HashableTypeRef (TypeR HashableTypeRef v)
-> TypeR HashableTypeRef v
forall (f :: * -> *) v a.
(Foldable f, Ord v) =>
a -> f (Term f v a) -> Term f v a
ABT.tm () (F' HashableTypeRef (TypeR HashableTypeRef v)
 -> TypeR HashableTypeRef v)
-> F' HashableTypeRef (TypeR HashableTypeRef v)
-> TypeR HashableTypeRef v
forall a b. (a -> b) -> a -> b
$ TypeR HashableTypeRef v
-> TypeR HashableTypeRef v
-> F' HashableTypeRef (TypeR HashableTypeRef v)
forall r a. a -> a -> F' r a
Type.App TypeR HashableTypeRef v
a TypeR HashableTypeRef v
b
            Type.Effect TypeR HashableTypeRef v
a TypeR HashableTypeRef v
b -> ()
-> F' HashableTypeRef (TypeR HashableTypeRef v)
-> TypeR HashableTypeRef v
forall (f :: * -> *) v a.
(Foldable f, Ord v) =>
a -> f (Term f v a) -> Term f v a
ABT.tm () (F' HashableTypeRef (TypeR HashableTypeRef v)
 -> TypeR HashableTypeRef v)
-> F' HashableTypeRef (TypeR HashableTypeRef v)
-> TypeR HashableTypeRef v
forall a b. (a -> b) -> a -> b
$ TypeR HashableTypeRef v
-> TypeR HashableTypeRef v
-> F' HashableTypeRef (TypeR HashableTypeRef v)
forall r a. a -> a -> F' r a
Type.Effect TypeR HashableTypeRef v
a TypeR HashableTypeRef v
b
            Type.Effects [TypeR HashableTypeRef v]
as -> ()
-> F' HashableTypeRef (TypeR HashableTypeRef v)
-> TypeR HashableTypeRef v
forall (f :: * -> *) v a.
(Foldable f, Ord v) =>
a -> f (Term f v a) -> Term f v a
ABT.tm () (F' HashableTypeRef (TypeR HashableTypeRef v)
 -> TypeR HashableTypeRef v)
-> F' HashableTypeRef (TypeR HashableTypeRef v)
-> TypeR HashableTypeRef v
forall a b. (a -> b) -> a -> b
$ [TypeR HashableTypeRef v]
-> F' HashableTypeRef (TypeR HashableTypeRef v)
forall r a. [a] -> F' r a
Type.Effects [TypeR HashableTypeRef v]
as
            Type.Forall TypeR HashableTypeRef v
a -> ()
-> F' HashableTypeRef (TypeR HashableTypeRef v)
-> TypeR HashableTypeRef v
forall (f :: * -> *) v a.
(Foldable f, Ord v) =>
a -> f (Term f v a) -> Term f v a
ABT.tm () (F' HashableTypeRef (TypeR HashableTypeRef v)
 -> TypeR HashableTypeRef v)
-> F' HashableTypeRef (TypeR HashableTypeRef v)
-> TypeR HashableTypeRef v
forall a b. (a -> b) -> a -> b
$ TypeR HashableTypeRef v
-> F' HashableTypeRef (TypeR HashableTypeRef v)
forall r a. a -> F' r a
Type.Forall TypeR HashableTypeRef v
a
            Type.IntroOuter TypeR HashableTypeRef v
a -> ()
-> F' HashableTypeRef (TypeR HashableTypeRef v)
-> TypeR HashableTypeRef v
forall (f :: * -> *) v a.
(Foldable f, Ord v) =>
a -> f (Term f v a) -> Term f v a
ABT.tm () (F' HashableTypeRef (TypeR HashableTypeRef v)
 -> TypeR HashableTypeRef v)
-> F' HashableTypeRef (TypeR HashableTypeRef v)
-> TypeR HashableTypeRef v
forall a b. (a -> b) -> a -> b
$ TypeR HashableTypeRef v
-> F' HashableTypeRef (TypeR HashableTypeRef v)
forall r a. a -> F' r a
Type.IntroOuter TypeR HashableTypeRef v
a