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

Disco.Syntax.Operators

Description

Unary and binary operators along with information like precedence, fixity, and concrete syntax.

Synopsis

Operators

data UOp Source #

Unary operators.

Constructors

Neg

Arithmetic negation (-)

Not

Logical negation (not)

Fact

Factorial (!)

Instances

Instances details
Eq UOp Source # 
Instance details

Defined in Disco.Syntax.Operators

Methods

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

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

Data UOp Source # 
Instance details

Defined in Disco.Syntax.Operators

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> UOp -> c UOp #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c UOp #

toConstr :: UOp -> Constr #

dataTypeOf :: UOp -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c UOp) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UOp) #

gmapT :: (forall b. Data b => b -> b) -> UOp -> UOp #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UOp -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UOp -> r #

gmapQ :: (forall d. Data d => d -> u) -> UOp -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> UOp -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> UOp -> m UOp #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> UOp -> m UOp #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> UOp -> m UOp #

Ord UOp Source # 
Instance details

Defined in Disco.Syntax.Operators

Methods

compare :: UOp -> UOp -> Ordering #

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

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

(>) :: UOp -> UOp -> Bool #

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

max :: UOp -> UOp -> UOp #

min :: UOp -> UOp -> UOp #

Read UOp Source # 
Instance details

Defined in Disco.Syntax.Operators

Show UOp Source # 
Instance details

Defined in Disco.Syntax.Operators

Methods

showsPrec :: Int -> UOp -> ShowS #

show :: UOp -> String #

showList :: [UOp] -> ShowS #

Generic UOp Source # 
Instance details

Defined in Disco.Syntax.Operators

Associated Types

type Rep UOp :: Type -> Type #

Methods

from :: UOp -> Rep UOp x #

to :: Rep UOp x -> UOp #

Alpha UOp Source # 
Instance details

Defined in Disco.Syntax.Operators

Pretty UOp Source #

Pretty-print a unary operator, by looking up its concrete syntax in the uopMap.

Instance details

Defined in Disco.Pretty

Methods

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

Subst t UOp Source # 
Instance details

Defined in Disco.Syntax.Operators

Methods

isvar :: UOp -> Maybe (SubstName UOp t) #

isCoerceVar :: UOp -> Maybe (SubstCoerce UOp t) #

subst :: Name t -> t -> UOp -> UOp #

substs :: [(Name t, t)] -> UOp -> UOp #

type Rep UOp Source # 
Instance details

Defined in Disco.Syntax.Operators

type Rep UOp = D1 ('MetaData "UOp" "Disco.Syntax.Operators" "disco-0.1.3.1-EVUeP3Z0O0d8zqKlGvDqh1" 'False) (C1 ('MetaCons "Neg" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "Not" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Fact" 'PrefixI 'False) (U1 :: Type -> Type)))

data BOp Source #

Binary operators.

Constructors

Add

Addition (+)

Sub

Subtraction (-)

SSub

Saturating Subtraction (.- / )

Mul

Multiplication (*)

Div

Division (/)

Exp

Exponentiation (^)

IDiv

Integer division (//)

Eq

Equality test (==)

Neq

Not-equal (/=)

Lt

Less than (<)

Gt

Greater than (>)

Leq

Less than or equal (<=)

Geq

Greater than or equal (>=)

Min

Minimum (min)

Max

Maximum (max)

And

Logical and (&& / and)

Or

Logical or (|| / or)

Impl

Logical implies (-> / implies)

Iff

Logical biconditional (- / iff)

Mod

Modulo (mod)

Divides

Divisibility test (|)

Choose

Binomial and multinomial coefficients (choose)

Cons

List cons (::)

CartProd

Cartesian product of sets (** / )

Union

Union of two sets (union / )

Inter

Intersection of two sets (intersect / )

Diff

Difference between two sets (@@)

Elem

Element test ()

Subset

Subset test ()

ShouldEq

Equality assertion (=!=)

Instances

Instances details
Eq BOp Source # 
Instance details

Defined in Disco.Syntax.Operators

Methods

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

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

Data BOp Source # 
Instance details

Defined in Disco.Syntax.Operators

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> BOp -> c BOp #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c BOp #

toConstr :: BOp -> Constr #

dataTypeOf :: BOp -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c BOp) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BOp) #

gmapT :: (forall b. Data b => b -> b) -> BOp -> BOp #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> BOp -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> BOp -> r #

gmapQ :: (forall d. Data d => d -> u) -> BOp -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> BOp -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> BOp -> m BOp #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> BOp -> m BOp #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> BOp -> m BOp #

Ord BOp Source # 
Instance details

Defined in Disco.Syntax.Operators

Methods

compare :: BOp -> BOp -> Ordering #

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

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

(>) :: BOp -> BOp -> Bool #

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

max :: BOp -> BOp -> BOp #

min :: BOp -> BOp -> BOp #

Read BOp Source # 
Instance details

Defined in Disco.Syntax.Operators

Show BOp Source # 
Instance details

Defined in Disco.Syntax.Operators

Methods

showsPrec :: Int -> BOp -> ShowS #

show :: BOp -> String #

showList :: [BOp] -> ShowS #

Generic BOp Source # 
Instance details

Defined in Disco.Syntax.Operators

Associated Types

type Rep BOp :: Type -> Type #

Methods

from :: BOp -> Rep BOp x #

to :: Rep BOp x -> BOp #

Alpha BOp Source # 
Instance details

Defined in Disco.Syntax.Operators

Pretty BOp Source #

Pretty-print a binary operator, by looking up its concrete syntax in the bopMap.

Instance details

Defined in Disco.Pretty

Methods

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

Subst t BOp Source # 
Instance details

Defined in Disco.Syntax.Operators

Methods

isvar :: BOp -> Maybe (SubstName BOp t) #

isCoerceVar :: BOp -> Maybe (SubstCoerce BOp t) #

subst :: Name t -> t -> BOp -> BOp #

substs :: [(Name t, t)] -> BOp -> BOp #

type Rep BOp Source # 
Instance details

Defined in Disco.Syntax.Operators

type Rep BOp = D1 ('MetaData "BOp" "Disco.Syntax.Operators" "disco-0.1.3.1-EVUeP3Z0O0d8zqKlGvDqh1" 'False) ((((C1 ('MetaCons "Add" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "Sub" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "SSub" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "Mul" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Div" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "Exp" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "IDiv" 'PrefixI 'False) (U1 :: Type -> Type)))) :+: (((C1 ('MetaCons "Eq" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Neq" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "Lt" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Gt" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "Leq" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Geq" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "Min" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Max" 'PrefixI 'False) (U1 :: Type -> Type))))) :+: (((C1 ('MetaCons "And" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "Or" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Impl" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "Iff" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Mod" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "Divides" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Choose" 'PrefixI 'False) (U1 :: Type -> Type)))) :+: (((C1 ('MetaCons "Cons" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "CartProd" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "Union" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Inter" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "Diff" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Elem" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "Subset" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "ShouldEq" 'PrefixI 'False) (U1 :: Type -> Type))))))

data TyOp Source #

Type operators.

Constructors

Enumerate

List all values of a type

Count

Count how many values there are of a type

Instances

Instances details
Eq TyOp Source # 
Instance details

Defined in Disco.Syntax.Operators

Methods

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

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

Data TyOp Source # 
Instance details

Defined in Disco.Syntax.Operators

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> TyOp -> c TyOp #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c TyOp #

toConstr :: TyOp -> Constr #

dataTypeOf :: TyOp -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c TyOp) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TyOp) #

gmapT :: (forall b. Data b => b -> b) -> TyOp -> TyOp #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> TyOp -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> TyOp -> r #

gmapQ :: (forall d. Data d => d -> u) -> TyOp -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> TyOp -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> TyOp -> m TyOp #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> TyOp -> m TyOp #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> TyOp -> m TyOp #

Ord TyOp Source # 
Instance details

Defined in Disco.Syntax.Operators

Methods

compare :: TyOp -> TyOp -> Ordering #

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

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

(>) :: TyOp -> TyOp -> Bool #

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

max :: TyOp -> TyOp -> TyOp #

min :: TyOp -> TyOp -> TyOp #

Show TyOp Source # 
Instance details

Defined in Disco.Syntax.Operators

Methods

showsPrec :: Int -> TyOp -> ShowS #

show :: TyOp -> String #

showList :: [TyOp] -> ShowS #

Generic TyOp Source # 
Instance details

Defined in Disco.Syntax.Operators

Associated Types

type Rep TyOp :: Type -> Type #

Methods

from :: TyOp -> Rep TyOp x #

to :: Rep TyOp x -> TyOp #

Alpha TyOp Source # 
Instance details

Defined in Disco.Syntax.Operators

Pretty TyOp Source # 
Instance details

Defined in Disco.Pretty

Methods

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

Subst t TyOp Source # 
Instance details

Defined in Disco.Syntax.Operators

Methods

isvar :: TyOp -> Maybe (SubstName TyOp t) #

isCoerceVar :: TyOp -> Maybe (SubstCoerce TyOp t) #

subst :: Name t -> t -> TyOp -> TyOp #

substs :: [(Name t, t)] -> TyOp -> TyOp #

type Rep TyOp Source # 
Instance details

Defined in Disco.Syntax.Operators

type Rep TyOp = D1 ('MetaData "TyOp" "Disco.Syntax.Operators" "disco-0.1.3.1-EVUeP3Z0O0d8zqKlGvDqh1" 'False) (C1 ('MetaCons "Enumerate" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Count" 'PrefixI 'False) (U1 :: Type -> Type))

Operator info

data UFixity Source #

Fixities of unary operators (either pre- or postfix).

Constructors

Pre

Unary prefix.

Post

Unary postfix.

Instances

Instances details
Bounded UFixity Source # 
Instance details

Defined in Disco.Syntax.Operators

Enum UFixity Source # 
Instance details

Defined in Disco.Syntax.Operators

Eq UFixity Source # 
Instance details

Defined in Disco.Syntax.Operators

Methods

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

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

Ord UFixity Source # 
Instance details

Defined in Disco.Syntax.Operators

Show UFixity Source # 
Instance details

Defined in Disco.Syntax.Operators

Generic UFixity Source # 
Instance details

Defined in Disco.Syntax.Operators

Associated Types

type Rep UFixity :: Type -> Type #

Methods

from :: UFixity -> Rep UFixity x #

to :: Rep UFixity x -> UFixity #

type Rep UFixity Source # 
Instance details

Defined in Disco.Syntax.Operators

type Rep UFixity = D1 ('MetaData "UFixity" "Disco.Syntax.Operators" "disco-0.1.3.1-EVUeP3Z0O0d8zqKlGvDqh1" 'False) (C1 ('MetaCons "Pre" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Post" 'PrefixI 'False) (U1 :: Type -> Type))

data BFixity Source #

Fixity/associativity of infix binary operators (either left, right, or non-associative).

Constructors

InL

Left-associative infix.

InR

Right-associative infix.

In

Infix.

Instances

Instances details
Bounded BFixity Source # 
Instance details

Defined in Disco.Syntax.Operators

Enum BFixity Source # 
Instance details

Defined in Disco.Syntax.Operators

Eq BFixity Source # 
Instance details

Defined in Disco.Syntax.Operators

Methods

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

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

Ord BFixity Source # 
Instance details

Defined in Disco.Syntax.Operators

Show BFixity Source # 
Instance details

Defined in Disco.Syntax.Operators

Generic BFixity Source # 
Instance details

Defined in Disco.Syntax.Operators

Associated Types

type Rep BFixity :: Type -> Type #

Methods

from :: BFixity -> Rep BFixity x #

to :: Rep BFixity x -> BFixity #

type Rep BFixity Source # 
Instance details

Defined in Disco.Syntax.Operators

type Rep BFixity = D1 ('MetaData "BFixity" "Disco.Syntax.Operators" "disco-0.1.3.1-EVUeP3Z0O0d8zqKlGvDqh1" 'False) (C1 ('MetaCons "InL" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "InR" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "In" 'PrefixI 'False) (U1 :: Type -> Type)))

data OpFixity Source #

Operators together with their fixity.

Constructors

UOpF UFixity UOp 
BOpF BFixity BOp 

Instances

Instances details
Eq OpFixity Source # 
Instance details

Defined in Disco.Syntax.Operators

Show OpFixity Source # 
Instance details

Defined in Disco.Syntax.Operators

Generic OpFixity Source # 
Instance details

Defined in Disco.Syntax.Operators

Associated Types

type Rep OpFixity :: Type -> Type #

Methods

from :: OpFixity -> Rep OpFixity x #

to :: Rep OpFixity x -> OpFixity #

type Rep OpFixity Source # 
Instance details

Defined in Disco.Syntax.Operators

data OpInfo Source #

An OpInfo record contains information about an operator, such as the operator itself, its fixity, a list of concrete syntax representations, and a numeric precedence level.

Constructors

OpInfo 

Fields

Instances

Instances details
Show OpInfo Source # 
Instance details

Defined in Disco.Syntax.Operators

Operator tables and lookup

opTable :: [[OpInfo]] Source #

The opTable lists all the operators in the language, in order of precedence (highest precedence first). Operators in the same list have the same precedence. This table is used by both the parser and the pretty-printer.

uopMap :: Map UOp OpInfo Source #

A map from all unary operators to their associated OpInfo records.

bopMap :: Map BOp OpInfo Source #

A map from all binary operators to their associatied OpInfo records.

uPrec :: UOp -> Int Source #

A convenient function for looking up the precedence of a unary operator.

bPrec :: BOp -> Int Source #

A convenient function for looking up the precedence of a binary operator.

assoc :: BOp -> BFixity Source #

Look up the "fixity" (i.e. associativity) of a binary operator.

funPrec :: Int Source #

The precedence level of function application (higher than any other precedence level).