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
}
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)
unhashComponent ::
forall v extra.
(ABT.Var v) =>
Hash ->
(Reference.Id -> v) ->
Map Reference.Id (Decl v, extra) ->
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
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))
Just (v
v, Decl v
_, extra
_) -> v -> Either v HashableTypeRef
forall a b. a -> Either a b
Left v
v
Maybe Hash
Nothing ->
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