disco-0.1.6: Functional programming language for teaching discrete math.
Copyrightdisco team and contributors
Maintainerbyorgey@gmail.com
Safe HaskellSafe-Inferred
LanguageHaskell2010

Disco.Types.Rules

Description

Disco.Types.Rules defines some generic rules about arity, subtyping, and sorts for disco base types.

Synopsis

Arity

data Variance Source #

A particular type argument can be either co- or contravariant with respect to subtyping.

Constructors

Co 
Contra 

Instances

Instances details
Read Variance Source # 
Instance details

Defined in Disco.Types.Rules

Show Variance Source # 
Instance details

Defined in Disco.Types.Rules

Eq Variance Source # 
Instance details

Defined in Disco.Types.Rules

Ord Variance Source # 
Instance details

Defined in Disco.Types.Rules

arity :: Con -> [Variance] Source #

The arity of a type constructor is a list of variances, expressing both how many type arguments the constructor takes, and the variance of each argument. This is used to decompose subtyping constraints.

For example, arity CArr = [Contra, Co] since function arrow is contravariant in its first argument and covariant in its second. That is, S1 -> T1 S2 - T2 (<: means "is a subtype of") if and only if S2 <: S1 and T1 <: T2.

Qualifiers

data Qualifier Source #

A "qualifier" is kind of like a type class in Haskell; but unlike Haskell, disco users cannot define their own. Rather, there is a finite fixed list of qualifiers supported by disco. For example, QSub denotes types which support a subtraction operation. Each qualifier corresponds to a set of types which satisfy it (see hasQual and qualRules).

These qualifiers generally arise from uses of various operations. For example, the expression \x y. x - y would be inferred to have a type a -> a -> a [subtractive a], that is, a function of type a -> a -> a where a is any type that supports subtraction.

These qualifiers can appear in a CQual constraint; see Disco.Typecheck.Constraint.

Constructors

QNum

Numeric, i.e. a semiring supporting + and *

QSub

Subtractive, i.e. supports -

QDiv

Divisive, i.e. supports /

QCmp

Comparable, i.e. supports decidable ordering/comparison (see Note [QCmp])

QEnum

Enumerable, i.e. supports ellipsis notation [x .. y]

QBool

Boolean, i.e. supports and, or, not (Bool or Prop)

QBasic

Things that do not involve Prop.

QSimple

Things for which we can derive a *Haskell* Ord instance

Instances

Instances details
Generic Qualifier Source # 
Instance details

Defined in Disco.Types.Qualifiers

Associated Types

type Rep Qualifier :: Type -> Type #

Show Qualifier Source # 
Instance details

Defined in Disco.Types.Qualifiers

Pretty Qualifier Source # 
Instance details

Defined in Disco.Types.Qualifiers

Methods

pretty :: forall (r :: EffectRow) ann. Members '[Reader PA, LFresh] r => Qualifier -> Sem r (Doc ann) Source #

Eq Qualifier Source # 
Instance details

Defined in Disco.Types.Qualifiers

Ord Qualifier Source # 
Instance details

Defined in Disco.Types.Qualifiers

Alpha Qualifier Source # 
Instance details

Defined in Disco.Types.Qualifiers

Subst Type Qualifier Source # 
Instance details

Defined in Disco.Types

type Rep Qualifier Source # 
Instance details

Defined in Disco.Types.Qualifiers

type Rep Qualifier = D1 ('MetaData "Qualifier" "Disco.Types.Qualifiers" "disco-0.1.6-4H4WbJGKK2PJTBCPs5wYLr" 'False) (((C1 ('MetaCons "QNum" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "QSub" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "QDiv" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "QCmp" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "QEnum" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "QBool" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "QBasic" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "QSimple" 'PrefixI 'False) (U1 :: Type -> Type))))

bopQual :: BOp -> Qualifier Source #

A helper function that returns the appropriate qualifier for a binary arithmetic operation.

Sorts

type Sort = Set Qualifier Source #

A Sort represents a set of qualifiers, and also represents a set of types (in general, the intersection of the sets corresponding to the qualifiers).

topSort :: Sort Source #

The special sort \(\top\) which includes all types.

Subtyping rules

data Dir Source #

A "direction" for the subtyping relation (either subtype or supertype).

Constructors

SubTy 
SuperTy 

Instances

Instances details
Read Dir Source # 
Instance details

Defined in Disco.Types.Rules

Show Dir Source # 
Instance details

Defined in Disco.Types.Rules

Methods

showsPrec :: Int -> Dir -> ShowS #

show :: Dir -> String #

showList :: [Dir] -> ShowS #

Eq Dir Source # 
Instance details

Defined in Disco.Types.Rules

Methods

(==) :: Dir -> Dir -> Bool #

(/=) :: Dir -> Dir -> Bool #

Ord Dir Source # 
Instance details

Defined in Disco.Types.Rules

Methods

compare :: Dir -> Dir -> Ordering #

(<) :: Dir -> Dir -> Bool #

(<=) :: Dir -> Dir -> Bool #

(>) :: Dir -> Dir -> Bool #

(>=) :: Dir -> Dir -> Bool #

max :: Dir -> Dir -> Dir #

min :: Dir -> Dir -> Dir #

other :: Dir -> Dir Source #

Swap directions.

isSubA :: Atom -> Atom -> Bool Source #

Check whether one atomic type is a subtype of the other. Returns True if either they are equal, or if they are base types and isSubB returns true.

isSubB :: BaseTy -> BaseTy -> Bool Source #

Check whether one base type is a subtype of another.

isDirB :: Dir -> BaseTy -> BaseTy -> Bool Source #

Check whether one base type is a sub- or supertype of another.

supertypes :: BaseTy -> [BaseTy] Source #

List all the supertypes of a given base type.

subtypes :: BaseTy -> [BaseTy] Source #

List all the subtypes of a given base type.

dirtypes :: Dir -> BaseTy -> [BaseTy] Source #

List all the sub- or supertypes of a given base type.

Qualifier and sort rules

hasQual :: BaseTy -> Qualifier -> Bool Source #

Check whether a given base type satisfies a qualifier.

hasSort :: BaseTy -> Sort -> Bool Source #

Check whether a base type has a certain sort, which simply amounts to whether it satisfies every qualifier in the sort.

qualRules :: Con -> Qualifier -> Maybe [Maybe Qualifier] Source #

Given a constructor T and a qualifier we want to hold of a type T t1 t2 ..., return a list of qualifiers that need to hold of t1, t2, ...

sortRules :: Con -> Sort -> Maybe [Sort] Source #

sortRules T s = [s1, ..., sn] means that sort s holds of type (T t1 ... tn) if and only if s1 t1 ... sn tn. For now this is just derived directly from qualRules.

This is the arity function described in section 4.1 of Traytel et al.

pickSortBaseTy :: Sort -> BaseTy Source #

Pick a base type (generally the "simplest") that satisfies a given sort.