Safe Haskell | None |
---|---|
Language | Haskell2010 |
Type schemes
Synopsis
- data Scheme varTypes typ k = Scheme {}
- sForAlls :: forall varTypes typ k varTypes. Lens (Scheme varTypes typ k) (Scheme varTypes typ k) (Tree varTypes QVars) (Tree varTypes QVars)
- sTyp :: forall varTypes typ k typ k. Lens (Scheme varTypes typ k) (Scheme varTypes typ k) ((#) k typ) ((#) k typ)
- data family KWitness k :: (Knot -> Type) -> Type
- newtype QVars typ = QVars (Map (QVar (GetKnot typ)) (TypeConstraintsOf (GetKnot typ)))
- _QVars :: forall typ typ. Iso (QVars typ) (QVars typ) (Map (QVar (GetKnot typ)) (TypeConstraintsOf (GetKnot typ))) (Map (QVar (GetKnot typ)) (TypeConstraintsOf (GetKnot typ)))
- class (Unify m t, HasChild varTypes t, Ord (QVar t)) => HasScheme varTypes m t where
- hasSchemeRecursive :: Proxy varTypes -> Proxy m -> Proxy t -> Dict (KNodesConstraint t (HasScheme varTypes m))
- loadScheme :: forall m varTypes typ. (Monad m, KTraversable varTypes, KNodesConstraint varTypes (Unify m), HasScheme varTypes m typ) => Tree Pure (Scheme varTypes typ) -> m (Tree (GTerm (UVarOf m)) typ)
- saveScheme :: (KNodesConstraint varTypes OrdQVar, KPointed varTypes, HasScheme varTypes m typ) => Tree (GTerm (UVarOf m)) typ -> m (Tree Pure (Scheme varTypes typ))
- class Unify m t => MonadInstantiate m t where
- localInstantiations :: Tree (QVarInstances (UVarOf m)) t -> m a -> m a
- lookupQVar :: QVar t -> m (Tree (UVarOf m) t)
- inferType :: (InferOf t ~ ANode t, KTraversable t, KNodesConstraint t HasInferredValue, Unify m t, MonadInstantiate m t) => Tree t (InferChild m k) -> m (Tree t k, Tree (InferOf t) (UVarOf m))
- newtype QVarInstances k typ = QVarInstances (Map (QVar (GetKnot typ)) (k typ))
- _QVarInstances :: forall k typ k typ. Iso (QVarInstances k typ) (QVarInstances k typ) (Map (QVar (GetKnot typ)) (k typ)) (Map (QVar (GetKnot typ)) (k typ))
- makeQVarInstances :: Unify m typ => Tree QVars typ -> m (Tree (QVarInstances (UVarOf m)) typ)
Documentation
data Scheme varTypes typ k Source #
A type scheme representing a polymorphic type.
Instances
sForAlls :: forall varTypes typ k varTypes. Lens (Scheme varTypes typ k) (Scheme varTypes typ k) (Tree varTypes QVars) (Tree varTypes QVars) Source #
sTyp :: forall varTypes typ k typ k. Lens (Scheme varTypes typ k) (Scheme varTypes typ k) ((#) k typ) ((#) k typ) Source #
data family KWitness k :: (Knot -> Type) -> Type Source #
KWitness k n
is a witness that n
is a node of k
Instances
Instances
_QVars :: forall typ typ. Iso (QVars typ) (QVars typ) (Map (QVar (GetKnot typ)) (TypeConstraintsOf (GetKnot typ))) (Map (QVar (GetKnot typ)) (TypeConstraintsOf (GetKnot typ))) Source #
class (Unify m t, HasChild varTypes t, Ord (QVar t)) => HasScheme varTypes m t where Source #
Nothing
hasSchemeRecursive :: Proxy varTypes -> Proxy m -> Proxy t -> Dict (KNodesConstraint t (HasScheme varTypes m)) Source #
hasSchemeRecursive :: KNodesConstraint t (HasScheme varTypes m) => Proxy varTypes -> Proxy m -> Proxy t -> Dict (KNodesConstraint t (HasScheme varTypes m)) Source #
loadScheme :: forall m varTypes typ. (Monad m, KTraversable varTypes, KNodesConstraint varTypes (Unify m), HasScheme varTypes m typ) => Tree Pure (Scheme varTypes typ) -> m (Tree (GTerm (UVarOf m)) typ) Source #
Load scheme into unification monad so that different instantiations share the scheme's monomorphic parts - their unification is O(1) as it is the same shared unification term.
saveScheme :: (KNodesConstraint varTypes OrdQVar, KPointed varTypes, HasScheme varTypes m typ) => Tree (GTerm (UVarOf m)) typ -> m (Tree Pure (Scheme varTypes typ)) Source #
class Unify m t => MonadInstantiate m t where Source #
localInstantiations :: Tree (QVarInstances (UVarOf m)) t -> m a -> m a Source #
inferType :: (InferOf t ~ ANode t, KTraversable t, KNodesConstraint t HasInferredValue, Unify m t, MonadInstantiate m t) => Tree t (InferChild m k) -> m (Tree t k, Tree (InferOf t) (UVarOf m)) Source #
newtype QVarInstances k typ Source #
QVarInstances (Map (QVar (GetKnot typ)) (k typ)) |
Instances
_QVarInstances :: forall k typ k typ. Iso (QVarInstances k typ) (QVarInstances k typ) (Map (QVar (GetKnot typ)) (k typ)) (Map (QVar (GetKnot typ)) (k typ)) Source #
makeQVarInstances :: Unify m typ => Tree QVars typ -> m (Tree (QVarInstances (UVarOf m)) typ) Source #