th-tc-0.1.0.0: Typechecking in Template Haskell

Safe HaskellNone
LanguageHaskell2010

Language.Haskell.TH.Typecheck

Contents

Description

Poor man's typechecker in Template Haskell. Capable of working with type synonyms, type families, DataKinds, kind polymorphism.

Levity polymorphism is currently not supported. Return kind inference in type families is not supported.

GHC cannot reify roles correctly, so we cannot solve Coercible constraints correctly, so instance resolution was left out.

Synopsis

Documentation

type MonadTc m = (Quasi m, MonadState TcScope m) Source #

Constraints for the typechecking monad. You probably want to use m ~ StateT TcScope Q

data TcScope Source #

Scope of the typechecker. Includes information about unificational vs rigid (skolem) type variables, and a cache of type information reified from GHC.

runTc :: Monad m => StateT TcScope m a -> m a Source #

Execute a typechecker computation. Unificational variables will not persist between different runTc blocks.

type TV = Name Source #

Type variable.

freshUnifTV :: MonadTc m => m TV Source #

Make a fresh (unused) unificational type variable. Unification will be able to replace this type variable with a concrete type.

extractKind :: MonadTc m => Type -> m Kind Source #

Attempt to compute the kind of a type. GHC doesn't give us complete kind information so this migth be more general than expected.

unifyTy :: MonadTc m => Type -> Type -> m () Source #

Assert that two types are equal, and replace unificational variables as necessary. Throws an error if the two types cannot be shown equal.

data UnifyResult Source #

Result of unification

Constructors

Apart String

The types are known to be different. (Includes an error message for if the types were expected to be equal).

Unknown String

The types may be different depending on substitutions of rigid type variables or not-yet-known type family instances. (Includes an error message for if the types were expected to be equal).

Equal

The types are known to be equal

unifyTyResult Source #

Arguments

:: MonadTc m 
=> Bool

expand type familes?

-> Type 
-> Type 
-> m UnifyResult 

Attempt unification and return an indication of whether the types were equal or not.

extractSubst :: MonadTc m => Type -> m [(TV, Type)] Source #

Recursively collect all zonked (unified with a type) unificational variables in the type, into a substitution. This is a separate step because we cannot actually replace the variables as the data structure is immutable.

substZonked :: MonadTc m => Type -> m Type Source #

Recursively replace all zonked unificational variables in the type.

Orphan instances