Safe Haskell | None |
---|---|
Language | Haskell2010 |
Open type representations and dynamic types
- type TR = AST
- class Typeable t a where
- newtype TypeRep t a = TypeRep {}
- typeRep :: Typeable t a => TypeRep t a
- class Render t => TypeEq t u where
- typeEq :: (TypeEq t t, MonadError String m) => TypeRep t a -> TypeRep t b -> m (Dict (a ~ b))
- matchCon :: TypeRep t c -> [E (TypeRep t)]
- matchConM :: Monad m => TypeRep t c -> m [E (TypeRep t)]
- class ShowClass p where
- class Witness p t u where
- class (ShowClass p, Render t) => PWitness p t u where
- pwitSymDefault :: Witness p t u => t sig -> Args (AST u) sig -> Either String (Dict (p (DenResult sig)))
- wit :: forall p t a. Witness p t t => Proxy p -> TypeRep t a -> Dict (p a)
- pwit :: forall p t m a. (PWitness p t t, MonadError String m) => Proxy p -> TypeRep t a -> m (Dict (p a))
- cast :: forall t a b. (Typeable t a, Typeable t b, TypeEq t t) => Proxy t -> a -> Either String b
- gcast :: forall t a b c. (Typeable t a, Typeable t b, TypeEq t t) => Proxy t -> c a -> Either String (c b)
- data Dynamic t where
- toDyn :: Typeable t a => a -> Dynamic t
- fromDyn :: forall t a. (Typeable t a, TypeEq t t) => Dynamic t -> Either String a
- class Any a
- witTypeable :: Witness (Typeable t) t t => TypeRep t a -> Dict (Typeable t a)
- pwitTypeable :: PWitness (Typeable t) t t => TypeRep t a -> Either String (Dict (Typeable t a))
- pAny :: Proxy Any
- pEq :: Proxy Eq
- pOrd :: Proxy Ord
- pShow :: Proxy Show
- pNum :: Proxy Num
- pIntegral :: Proxy Integral
- data BoolType a where
- data CharType a where
- data IntType a where
- data FloatType a where
- data ListType a where
- data FunType a where
- boolType :: (Syntactic a, BoolType :<: Domain a, Internal a ~ Bool) => a
- charType :: (Syntactic a, CharType :<: Domain a, Internal a ~ Char) => a
- intType :: (Syntactic a, IntType :<: Domain a, Internal a ~ Int) => a
- floatType :: (Syntactic a, FloatType :<: Domain a, Internal a ~ Float) => a
- listType :: (Syntactic list, Syntactic elem, Domain list ~ Domain elem, ListType :<: Domain list, Internal list ~ [Internal elem], elem ~ c e, list ~ c l) => elem -> list
- funType :: (Syntactic fun, Syntactic a, Syntactic b, Domain fun ~ Domain a, Domain fun ~ Domain b, FunType :<: Domain fun, Internal fun ~ (Internal a -> Internal b), a ~ c x, b ~ c y, fun ~ c z) => a -> b -> fun
- dynToInteger :: PWitness Integral t t => Dynamic t -> Either String Integer
Type representations
class Typeable t a where Source
This class provides reification of type a
in a universe t
.
means that Typeable
t aa
is in the type universe represented by t
.
Representation of type a
in a type universe t
This type can also be seen as a witness that a
is a member of t
(i.e.
); see
Typeable
t awitTypeable
.
class Render t => TypeEq t u where Source
Equality on type representations
typeEq :: (TypeEq t t, MonadError String m) => TypeRep t a -> TypeRep t b -> m (Dict (a ~ b)) Source
Equality on type representations
matchCon :: TypeRep t c -> [E (TypeRep t)] Source
Type constructor matching. This function makes it possible to match on type representations
without dealing with the underlying AST
representation.
For example, to check that a TypeRep
represents the type a -> Int
for some a
:
is_atoi :: (TypeEq t t, IntType :<: t) => TypeRep t a -> Bool is_atoi t | [E ta, E tb] <- matchCon t , Just _ <- typeEq ta intType = True | otherwise = False
class Witness p t u where Source
Witness a type constraint for a reified type
class (ShowClass p, Render t) => PWitness p t u where Source
Partially witness a type constraint for a reified type
Nothing
pwitSymDefault :: Witness p t u => t sig -> Args (AST u) sig -> Either String (Dict (p (DenResult sig))) Source
wit :: forall p t a. Witness p t t => Proxy p -> TypeRep t a -> Dict (p a) Source
Witness a type constraint for a reified type
pwit :: forall p t m a. (PWitness p t t, MonadError String m) => Proxy p -> TypeRep t a -> m (Dict (p a)) Source
Partially witness a type constraint for a reified type
Dynamic types
cast :: forall t a b. (Typeable t a, Typeable t b, TypeEq t t) => Proxy t -> a -> Either String b Source
Safe cast (does not use unsafeCoerce
)
gcast :: forall t a b c. (Typeable t a, Typeable t b, TypeEq t t) => Proxy t -> c a -> Either String (c b) Source
Safe generalized cast (does not use unsafeCoerce
)
Dynamic type parameterized on a type universe
Specific types/classes
The universal class
witTypeable :: Witness (Typeable t) t t => TypeRep t a -> Dict (Typeable t a) Source
Witness a Typeable
constraint for a reified type
pwitTypeable :: PWitness (Typeable t) t t => TypeRep t a -> Either String (Dict (Typeable t a)) Source
Partially witness a Typeable
constraint for a reified type
Render BoolType | |
VarArg BoolType | |
TypeEq BoolType t | |
PWitness Eq BoolType t | |
PWitness Integral BoolType t | |
PWitness Num BoolType t | |
PWitness Ord BoolType t | |
PWitness Show BoolType t | |
PWitness Any BoolType t | |
Witness Eq BoolType t | |
Witness Ord BoolType t | |
Witness Show BoolType t | |
Witness Any BoolType t | |
(:<:) BoolType t => PWitness (Typeable t) BoolType t | |
(:<:) BoolType t => Witness (Typeable t) BoolType t |
Render CharType | |
VarArg CharType | |
TypeEq CharType t | |
PWitness Eq CharType t | |
PWitness Integral CharType t | |
PWitness Num CharType t | |
PWitness Ord CharType t | |
PWitness Show CharType t | |
PWitness Any CharType t | |
Witness Eq CharType t | |
Witness Ord CharType t | |
Witness Show CharType t | |
Witness Any CharType t | |
(:<:) CharType t => PWitness (Typeable t) CharType t | |
(:<:) CharType t => Witness (Typeable t) CharType t |
Render IntType | |
VarArg IntType | |
TypeEq IntType t | |
PWitness Eq IntType t | |
PWitness Integral IntType t | |
PWitness Num IntType t | |
PWitness Ord IntType t | |
PWitness Show IntType t | |
PWitness Any IntType t | |
Witness Eq IntType t | |
Witness Integral IntType t | |
Witness Num IntType t | |
Witness Ord IntType t | |
Witness Show IntType t | |
Witness Any IntType t | |
(:<:) IntType t => PWitness (Typeable t) IntType t | |
(:<:) IntType t => Witness (Typeable t) IntType t |
Render FloatType | |
VarArg FloatType | |
TypeEq FloatType t | |
PWitness Eq FloatType t | |
PWitness Integral FloatType t | |
PWitness Num FloatType t | |
PWitness Ord FloatType t | |
PWitness Show FloatType t | |
PWitness Any FloatType t | |
Witness Eq FloatType t | |
Witness Num FloatType t | |
Witness Ord FloatType t | |
Witness Show FloatType t | |
Witness Any FloatType t | |
(:<:) FloatType t => PWitness (Typeable t) FloatType t | |
(:<:) FloatType t => Witness (Typeable t) FloatType t |
Render ListType | |
VarArg ListType | |
TypeEq t t => TypeEq ListType t | |
PWitness Eq t t => PWitness Eq ListType t | |
PWitness Integral ListType t | |
PWitness Num ListType t | |
PWitness Ord t t => PWitness Ord ListType t | |
PWitness Show t t => PWitness Show ListType t | |
PWitness Any ListType t | |
Witness Eq t t => Witness Eq ListType t | |
Witness Ord t t => Witness Ord ListType t | |
Witness Show t t => Witness Show ListType t | |
Witness Any ListType t | |
((:<:) ListType t, PWitness (Typeable t) t t) => PWitness (Typeable t) ListType t | |
((:<:) ListType t, Witness (Typeable t) t t) => Witness (Typeable t) ListType t |
Render FunType | |
VarArg FunType | |
TypeEq t t => TypeEq FunType t | |
PWitness Eq FunType t | |
PWitness Integral FunType t | |
PWitness Num FunType t | |
PWitness Ord FunType t | |
PWitness Show FunType t | |
PWitness Any FunType t | |
Witness Any FunType t | |
((:<:) FunType t, PWitness (Typeable t) t t) => PWitness (Typeable t) FunType t | |
((:<:) FunType t, Witness (Typeable t) t t) => Witness (Typeable t) FunType t |
listType :: (Syntactic list, Syntactic elem, Domain list ~ Domain elem, ListType :<: Domain list, Internal list ~ [Internal elem], elem ~ c e, list ~ c l) => elem -> list Source