language-Modula2-0.1.3: Parser, pretty-printer, and more for the Modula-2 programming language
Safe HaskellSafe-Inferred
LanguageHaskell2010

Language.Modula2.Abstract

Description

Finally Tagless Abstract Syntax Tree definitions for the programming language Modula-2

Synopsis

Documentation

type Ident = Text #

type BaseType l = QualIdent l #

type Priority l = ConstExpression l Source #

Module priority

class Wirthy l where #

The finally-tagless associated types and methods relevant to all programming languages designed by Niklaus Wirth. Every non-leaf node type has four type variables:

  • type variable l represents the language of the constructs built by the methods,
  • l' is the language of the child node constructs,
  • f' wraps all descendant nodes, except
  • f wraps all direct children of the node.

Associated Types

type Module l = (m :: Type -> (Type -> Type) -> (Type -> Type) -> Type) | m -> l #

type Declaration l = (d :: Type -> (Type -> Type) -> (Type -> Type) -> Type) | d -> l #

type Type l = (t :: Type -> (Type -> Type) -> (Type -> Type) -> Type) | t -> l #

type Statement l = (s :: Type -> (Type -> Type) -> (Type -> Type) -> Type) | s -> l #

type Expression l = (e :: Type -> (Type -> Type) -> (Type -> Type) -> Type) | e -> l #

type Designator l = (d :: Type -> (Type -> Type) -> (Type -> Type) -> Type) | d -> l #

type Value l = (v :: Type -> (Type -> Type) -> (Type -> Type) -> Type) | v -> l #

type FieldList l = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) | x -> l #

type ProcedureHeading l = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) | x -> l #

type FormalParameters l = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) | x -> l #

type FPSection l = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) | x -> l #

type Block l = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) | x -> l #

type StatementSequence l = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) | x -> l #

type Case l = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) | x -> l #

type CaseLabels l = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) | x -> l #

type ConditionalBranch l = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) | x -> l #

type Element l = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) | x -> l #

type Import l = (x :: Type) | x -> l #

type IdentDef l = (x :: Type) | x -> l #

type QualIdent l = (x :: Type) | x -> l #

Methods

constantDeclaration :: forall l' f (f' :: Type -> Type). IdentDef l' -> f (ConstExpression l' l' f' f') -> Declaration l l' f' f #

typeDeclaration :: forall l' f (f' :: Type -> Type). IdentDef l' -> f (Type l' l' f' f') -> Declaration l l' f' f #

variableDeclaration :: forall l' f (f' :: Type -> Type). IdentList l' -> f (Type l' l' f' f') -> Declaration l l' f' f #

procedureDeclaration :: forall f l' (f' :: Type -> Type). f (ProcedureHeading l' l' f' f') -> f (Block l' l' f' f') -> Declaration l l' f' f #

formalParameters :: forall f l' (f' :: Type -> Type). [f (FPSection l' l' f' f')] -> Maybe (ReturnType l') -> FormalParameters l l' f' f #

fpSection :: forall f l' (f' :: Type -> Type). Bool -> [Ident] -> f (Type l' l' f' f') -> FPSection l l' f' f #

block :: forall f l' (f' :: Type -> Type). [f (Declaration l' l' f' f')] -> Maybe (f (StatementSequence l' l' f' f')) -> Block l l' f' f #

fieldList :: forall l' f (f' :: Type -> Type). NonEmpty (IdentDef l') -> f (Type l' l' f' f') -> FieldList l l' f' f #

pointerType :: forall f l' (f' :: Type -> Type). f (Type l' l' f' f') -> Type l l' f' f #

procedureType :: forall f l' (f' :: Type -> Type). Maybe (f (FormalParameters l' l' f' f')) -> Type l l' f' f #

typeReference :: forall l' (f' :: Type -> Type) (f :: Type -> Type). QualIdent l' -> Type l l' f' f #

assignment :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> f (Expression l' l' f' f') -> Statement l l' f' f #

caseStatement :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> [f (Case l' l' f' f')] -> Maybe (f (StatementSequence l' l' f' f')) -> Statement l l' f' f #

emptyStatement :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Statement l l' f' f #

exitStatement :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Statement l l' f' f #

ifStatement :: forall f l' (f' :: Type -> Type). NonEmpty (f (ConditionalBranch l' l' f' f')) -> Maybe (f (StatementSequence l' l' f' f')) -> Statement l l' f' f #

loopStatement :: forall f l' (f' :: Type -> Type). f (StatementSequence l' l' f' f') -> Statement l l' f' f #

procedureCall :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> Maybe [f (Expression l' l' f' f')] -> Statement l l' f' f #

repeatStatement :: forall f l' (f' :: Type -> Type). f (StatementSequence l' l' f' f') -> f (Expression l' l' f' f') -> Statement l l' f' f #

returnStatement :: forall f l' (f' :: Type -> Type). Maybe (f (Expression l' l' f' f')) -> Statement l l' f' f #

whileStatement :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (StatementSequence l' l' f' f') -> Statement l l' f' f #

conditionalBranch :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (StatementSequence l' l' f' f') -> ConditionalBranch l l' f' f #

caseAlternative :: forall f l' (f' :: Type -> Type). NonEmpty (f (CaseLabels l' l' f' f')) -> f (StatementSequence l' l' f' f') -> Case l l' f' f #

singleLabel :: forall f l' (f' :: Type -> Type). f (ConstExpression l' l' f' f') -> CaseLabels l l' f' f #

labelRange :: forall f l' (f' :: Type -> Type). f (ConstExpression l' l' f' f') -> f (ConstExpression l' l' f' f') -> CaseLabels l l' f' f #

statementSequence :: forall f l' (f' :: Type -> Type). [f (Statement l' l' f' f')] -> StatementSequence l l' f' f #

add :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression l l' f' f #

subtract :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression l l' f' f #

and :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression l l' f' f #

or :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression l l' f' f #

divide :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression l l' f' f #

integerDivide :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression l l' f' f #

modulo :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression l l' f' f #

multiply :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression l l' f' f #

functionCall :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> [f (Expression l' l' f' f')] -> Expression l l' f' f #

literal :: forall f l' (f' :: Type -> Type). f (Value l' l' f' f') -> Expression l l' f' f #

negative :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> Expression l l' f' f #

positive :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> Expression l l' f' f #

not :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> Expression l l' f' f #

read :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> Expression l l' f' f #

relation :: forall f l' (f' :: Type -> Type). RelOp -> f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression l l' f' f #

element :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> Element l l' f' f #

range :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Element l l' f' f #

integer :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Integer -> Value l l' f' f #

nil :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Value l l' f' f #

false :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Value l l' f' f #

true :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Value l l' f' f #

real :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Double -> Value l l' f' f #

string :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Text -> Value l l' f' f #

charCode :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Int -> Value l l' f' f #

builtin :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Text -> Value l l' f' f #

variable :: forall l' (f' :: Type -> Type) (f :: Type -> Type). QualIdent l' -> Designator l l' f' f #

field :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> Ident -> Designator l l' f' f #

index :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> NonEmpty (f (Expression l' l' f' f')) -> Designator l l' f' f #

dereference :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> Designator l l' f' f #

identDef :: Ident -> IdentDef l #

nonQualIdent :: Ident -> QualIdent l #

Instances

Instances details
Wirthy Language Source # 
Instance details

Defined in Language.Modula2.AST

Associated Types

type Module Language = (m :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Declaration Language = (d :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Type Language = (t :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Statement Language = (s :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Expression Language = (e :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Designator Language = (d :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Value Language = (v :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type FieldList Language = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type ProcedureHeading Language = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type FormalParameters Language = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type FPSection Language = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Block Language = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type StatementSequence Language = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Case Language = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type CaseLabels Language = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type ConditionalBranch Language = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Element Language = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Import Language = (x :: Type) #

type IdentDef Language = (x :: Type) #

type QualIdent Language = (x :: Type) #

Methods

constantDeclaration :: forall l' f (f' :: Type -> Type). IdentDef l' -> f (ConstExpression l' l' f' f') -> Declaration Language l' f' f #

typeDeclaration :: forall l' f (f' :: Type -> Type). IdentDef l' -> f (Type l' l' f' f') -> Declaration Language l' f' f #

variableDeclaration :: forall l' f (f' :: Type -> Type). IdentList l' -> f (Type l' l' f' f') -> Declaration Language l' f' f #

procedureDeclaration :: forall f l' (f' :: Type -> Type). f (ProcedureHeading l' l' f' f') -> f (Block l' l' f' f') -> Declaration Language l' f' f #

formalParameters :: forall f l' (f' :: Type -> Type). [f (FPSection l' l' f' f')] -> Maybe (ReturnType l') -> FormalParameters Language l' f' f #

fpSection :: forall f l' (f' :: Type -> Type). Bool -> [Ident] -> f (Type l' l' f' f') -> FPSection Language l' f' f #

block :: forall f l' (f' :: Type -> Type). [f (Declaration l' l' f' f')] -> Maybe (f (StatementSequence l' l' f' f')) -> Block Language l' f' f #

fieldList :: forall l' f (f' :: Type -> Type). NonEmpty (IdentDef l') -> f (Type l' l' f' f') -> FieldList Language l' f' f #

pointerType :: forall f l' (f' :: Type -> Type). f (Type l' l' f' f') -> Type Language l' f' f #

procedureType :: forall f l' (f' :: Type -> Type). Maybe (f (FormalParameters l' l' f' f')) -> Type Language l' f' f #

typeReference :: forall l' (f' :: Type -> Type) (f :: Type -> Type). QualIdent l' -> Type Language l' f' f #

assignment :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> f (Expression l' l' f' f') -> Statement Language l' f' f #

caseStatement :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> [f (Case l' l' f' f')] -> Maybe (f (StatementSequence l' l' f' f')) -> Statement Language l' f' f #

emptyStatement :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Statement Language l' f' f #

exitStatement :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Statement Language l' f' f #

ifStatement :: forall f l' (f' :: Type -> Type). NonEmpty (f (ConditionalBranch l' l' f' f')) -> Maybe (f (StatementSequence l' l' f' f')) -> Statement Language l' f' f #

loopStatement :: forall f l' (f' :: Type -> Type). f (StatementSequence l' l' f' f') -> Statement Language l' f' f #

procedureCall :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> Maybe [f (Expression l' l' f' f')] -> Statement Language l' f' f #

repeatStatement :: forall f l' (f' :: Type -> Type). f (StatementSequence l' l' f' f') -> f (Expression l' l' f' f') -> Statement Language l' f' f #

returnStatement :: forall f l' (f' :: Type -> Type). Maybe (f (Expression l' l' f' f')) -> Statement Language l' f' f #

whileStatement :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (StatementSequence l' l' f' f') -> Statement Language l' f' f #

conditionalBranch :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (StatementSequence l' l' f' f') -> ConditionalBranch Language l' f' f #

caseAlternative :: forall f l' (f' :: Type -> Type). NonEmpty (f (CaseLabels l' l' f' f')) -> f (StatementSequence l' l' f' f') -> Case Language l' f' f #

singleLabel :: forall f l' (f' :: Type -> Type). f (ConstExpression l' l' f' f') -> CaseLabels Language l' f' f #

labelRange :: forall f l' (f' :: Type -> Type). f (ConstExpression l' l' f' f') -> f (ConstExpression l' l' f' f') -> CaseLabels Language l' f' f #

statementSequence :: forall f l' (f' :: Type -> Type). [f (Statement l' l' f' f')] -> StatementSequence Language l' f' f #

add :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression Language l' f' f #

subtract :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression Language l' f' f #

and :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression Language l' f' f #

or :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression Language l' f' f #

divide :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression Language l' f' f #

integerDivide :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression Language l' f' f #

modulo :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression Language l' f' f #

multiply :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression Language l' f' f #

functionCall :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> [f (Expression l' l' f' f')] -> Expression Language l' f' f #

literal :: forall f l' (f' :: Type -> Type). f (Value l' l' f' f') -> Expression Language l' f' f #

negative :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> Expression Language l' f' f #

positive :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> Expression Language l' f' f #

not :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> Expression Language l' f' f #

read :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> Expression Language l' f' f #

relation :: forall f l' (f' :: Type -> Type). RelOp -> f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression Language l' f' f #

element :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> Element Language l' f' f #

range :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Element Language l' f' f #

integer :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Integer -> Value Language l' f' f #

nil :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Value Language l' f' f #

false :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Value Language l' f' f #

true :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Value Language l' f' f #

real :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Double -> Value Language l' f' f #

string :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Text -> Value Language l' f' f #

charCode :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Int -> Value Language l' f' f #

builtin :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Text -> Value Language l' f' f #

variable :: forall l' (f' :: Type -> Type) (f :: Type -> Type). QualIdent l' -> Designator Language l' f' f #

field :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> Ident -> Designator Language l' f' f #

index :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> NonEmpty (f (Expression l' l' f' f')) -> Designator Language l' f' f #

dereference :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> Designator Language l' f' f #

identDef :: Ident -> IdentDef Language #

nonQualIdent :: Ident -> QualIdent Language #

Wirthy Language Source # 
Instance details

Defined in Language.Modula2.ISO.AST

Associated Types

type Module Language = (m :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Declaration Language = (d :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Type Language = (t :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Statement Language = (s :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Expression Language = (e :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Designator Language = (d :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Value Language = (v :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type FieldList Language = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type ProcedureHeading Language = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type FormalParameters Language = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type FPSection Language = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Block Language = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type StatementSequence Language = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Case Language = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type CaseLabels Language = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type ConditionalBranch Language = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Element Language = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Import Language = (x :: Type) #

type IdentDef Language = (x :: Type) #

type QualIdent Language = (x :: Type) #

Methods

constantDeclaration :: forall l' f (f' :: Type -> Type). IdentDef l' -> f (ConstExpression l' l' f' f') -> Declaration Language l' f' f #

typeDeclaration :: forall l' f (f' :: Type -> Type). IdentDef l' -> f (Type l' l' f' f') -> Declaration Language l' f' f #

variableDeclaration :: forall l' f (f' :: Type -> Type). IdentList l' -> f (Type l' l' f' f') -> Declaration Language l' f' f #

procedureDeclaration :: forall f l' (f' :: Type -> Type). f (ProcedureHeading l' l' f' f') -> f (Block l' l' f' f') -> Declaration Language l' f' f #

formalParameters :: forall f l' (f' :: Type -> Type). [f (FPSection l' l' f' f')] -> Maybe (ReturnType l') -> FormalParameters Language l' f' f #

fpSection :: forall f l' (f' :: Type -> Type). Bool -> [Ident] -> f (Type l' l' f' f') -> FPSection Language l' f' f #

block :: forall f l' (f' :: Type -> Type). [f (Declaration l' l' f' f')] -> Maybe (f (StatementSequence l' l' f' f')) -> Block Language l' f' f #

fieldList :: forall l' f (f' :: Type -> Type). NonEmpty (IdentDef l') -> f (Type l' l' f' f') -> FieldList Language l' f' f #

pointerType :: forall f l' (f' :: Type -> Type). f (Type l' l' f' f') -> Type Language l' f' f #

procedureType :: forall f l' (f' :: Type -> Type). Maybe (f (FormalParameters l' l' f' f')) -> Type Language l' f' f #

typeReference :: forall l' (f' :: Type -> Type) (f :: Type -> Type). QualIdent l' -> Type Language l' f' f #

assignment :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> f (Expression l' l' f' f') -> Statement Language l' f' f #

caseStatement :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> [f (Case l' l' f' f')] -> Maybe (f (StatementSequence l' l' f' f')) -> Statement Language l' f' f #

emptyStatement :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Statement Language l' f' f #

exitStatement :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Statement Language l' f' f #

ifStatement :: forall f l' (f' :: Type -> Type). NonEmpty (f (ConditionalBranch l' l' f' f')) -> Maybe (f (StatementSequence l' l' f' f')) -> Statement Language l' f' f #

loopStatement :: forall f l' (f' :: Type -> Type). f (StatementSequence l' l' f' f') -> Statement Language l' f' f #

procedureCall :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> Maybe [f (Expression l' l' f' f')] -> Statement Language l' f' f #

repeatStatement :: forall f l' (f' :: Type -> Type). f (StatementSequence l' l' f' f') -> f (Expression l' l' f' f') -> Statement Language l' f' f #

returnStatement :: forall f l' (f' :: Type -> Type). Maybe (f (Expression l' l' f' f')) -> Statement Language l' f' f #

whileStatement :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (StatementSequence l' l' f' f') -> Statement Language l' f' f #

conditionalBranch :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (StatementSequence l' l' f' f') -> ConditionalBranch Language l' f' f #

caseAlternative :: forall f l' (f' :: Type -> Type). NonEmpty (f (CaseLabels l' l' f' f')) -> f (StatementSequence l' l' f' f') -> Case Language l' f' f #

singleLabel :: forall f l' (f' :: Type -> Type). f (ConstExpression l' l' f' f') -> CaseLabels Language l' f' f #

labelRange :: forall f l' (f' :: Type -> Type). f (ConstExpression l' l' f' f') -> f (ConstExpression l' l' f' f') -> CaseLabels Language l' f' f #

statementSequence :: forall f l' (f' :: Type -> Type). [f (Statement l' l' f' f')] -> StatementSequence Language l' f' f #

add :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression Language l' f' f #

subtract :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression Language l' f' f #

and :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression Language l' f' f #

or :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression Language l' f' f #

divide :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression Language l' f' f #

integerDivide :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression Language l' f' f #

modulo :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression Language l' f' f #

multiply :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression Language l' f' f #

functionCall :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> [f (Expression l' l' f' f')] -> Expression Language l' f' f #

literal :: forall f l' (f' :: Type -> Type). f (Value l' l' f' f') -> Expression Language l' f' f #

negative :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> Expression Language l' f' f #

positive :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> Expression Language l' f' f #

not :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> Expression Language l' f' f #

read :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> Expression Language l' f' f #

relation :: forall f l' (f' :: Type -> Type). RelOp -> f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression Language l' f' f #

element :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> Element Language l' f' f #

range :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Element Language l' f' f #

integer :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Integer -> Value Language l' f' f #

nil :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Value Language l' f' f #

false :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Value Language l' f' f #

true :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Value Language l' f' f #

real :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Double -> Value Language l' f' f #

string :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Text -> Value Language l' f' f #

charCode :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Int -> Value Language l' f' f #

builtin :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Text -> Value Language l' f' f #

variable :: forall l' (f' :: Type -> Type) (f :: Type -> Type). QualIdent l' -> Designator Language l' f' f #

field :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> Ident -> Designator Language l' f' f #

index :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> NonEmpty (f (Expression l' l' f' f')) -> Designator Language l' f' f #

dereference :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> Designator Language l' f' f #

identDef :: Ident -> IdentDef Language #

nonQualIdent :: Ident -> QualIdent Language #

Wirthy Language 
Instance details

Defined in Language.Oberon.AST

Associated Types

type Module Language = (m :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Declaration Language = (d :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Type Language = (t :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Statement Language = (s :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Expression Language = (e :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Designator Language = (d :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Value Language = (v :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type FieldList Language = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type ProcedureHeading Language = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type FormalParameters Language = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type FPSection Language = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Block Language = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type StatementSequence Language = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Case Language = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type CaseLabels Language = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type ConditionalBranch Language = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Element Language = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Import Language = (x :: Type) #

type IdentDef Language = (x :: Type) #

type QualIdent Language = (x :: Type) #

Methods

constantDeclaration :: forall l' f (f' :: Type -> Type). IdentDef l' -> f (ConstExpression l' l' f' f') -> Declaration Language l' f' f #

typeDeclaration :: forall l' f (f' :: Type -> Type). IdentDef l' -> f (Type l' l' f' f') -> Declaration Language l' f' f #

variableDeclaration :: forall l' f (f' :: Type -> Type). IdentList l' -> f (Type l' l' f' f') -> Declaration Language l' f' f #

procedureDeclaration :: forall f l' (f' :: Type -> Type). f (ProcedureHeading l' l' f' f') -> f (Block l' l' f' f') -> Declaration Language l' f' f #

formalParameters :: forall f l' (f' :: Type -> Type). [f (FPSection l' l' f' f')] -> Maybe (ReturnType l') -> FormalParameters Language l' f' f #

fpSection :: forall f l' (f' :: Type -> Type). Bool -> [Ident] -> f (Type l' l' f' f') -> FPSection Language l' f' f #

block :: forall f l' (f' :: Type -> Type). [f (Declaration l' l' f' f')] -> Maybe (f (StatementSequence l' l' f' f')) -> Block Language l' f' f #

fieldList :: forall l' f (f' :: Type -> Type). NonEmpty (IdentDef l') -> f (Type l' l' f' f') -> FieldList Language l' f' f #

pointerType :: forall f l' (f' :: Type -> Type). f (Type l' l' f' f') -> Type Language l' f' f #

procedureType :: forall f l' (f' :: Type -> Type). Maybe (f (FormalParameters l' l' f' f')) -> Type Language l' f' f #

typeReference :: forall l' (f' :: Type -> Type) (f :: Type -> Type). QualIdent l' -> Type Language l' f' f #

assignment :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> f (Expression l' l' f' f') -> Statement Language l' f' f #

caseStatement :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> [f (Case l' l' f' f')] -> Maybe (f (StatementSequence l' l' f' f')) -> Statement Language l' f' f #

emptyStatement :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Statement Language l' f' f #

exitStatement :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Statement Language l' f' f #

ifStatement :: forall f l' (f' :: Type -> Type). NonEmpty (f (ConditionalBranch l' l' f' f')) -> Maybe (f (StatementSequence l' l' f' f')) -> Statement Language l' f' f #

loopStatement :: forall f l' (f' :: Type -> Type). f (StatementSequence l' l' f' f') -> Statement Language l' f' f #

procedureCall :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> Maybe [f (Expression l' l' f' f')] -> Statement Language l' f' f #

repeatStatement :: forall f l' (f' :: Type -> Type). f (StatementSequence l' l' f' f') -> f (Expression l' l' f' f') -> Statement Language l' f' f #

returnStatement :: forall f l' (f' :: Type -> Type). Maybe (f (Expression l' l' f' f')) -> Statement Language l' f' f #

whileStatement :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (StatementSequence l' l' f' f') -> Statement Language l' f' f #

conditionalBranch :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (StatementSequence l' l' f' f') -> ConditionalBranch Language l' f' f #

caseAlternative :: forall f l' (f' :: Type -> Type). NonEmpty (f (CaseLabels l' l' f' f')) -> f (StatementSequence l' l' f' f') -> Case Language l' f' f #

singleLabel :: forall f l' (f' :: Type -> Type). f (ConstExpression l' l' f' f') -> CaseLabels Language l' f' f #

labelRange :: forall f l' (f' :: Type -> Type). f (ConstExpression l' l' f' f') -> f (ConstExpression l' l' f' f') -> CaseLabels Language l' f' f #

statementSequence :: forall f l' (f' :: Type -> Type). [f (Statement l' l' f' f')] -> StatementSequence Language l' f' f #

add :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression Language l' f' f #

subtract :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression Language l' f' f #

and :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression Language l' f' f #

or :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression Language l' f' f #

divide :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression Language l' f' f #

integerDivide :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression Language l' f' f #

modulo :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression Language l' f' f #

multiply :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression Language l' f' f #

functionCall :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> [f (Expression l' l' f' f')] -> Expression Language l' f' f #

literal :: forall f l' (f' :: Type -> Type). f (Value l' l' f' f') -> Expression Language l' f' f #

negative :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> Expression Language l' f' f #

positive :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> Expression Language l' f' f #

not :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> Expression Language l' f' f #

read :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> Expression Language l' f' f #

relation :: forall f l' (f' :: Type -> Type). RelOp -> f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression Language l' f' f #

element :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> Element Language l' f' f #

range :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Element Language l' f' f #

integer :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Integer -> Value Language l' f' f #

nil :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Value Language l' f' f #

false :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Value Language l' f' f #

true :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Value Language l' f' f #

real :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Double -> Value Language l' f' f #

string :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Text -> Value Language l' f' f #

charCode :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Int -> Value Language l' f' f #

builtin :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Text -> Value Language l' f' f #

variable :: forall l' (f' :: Type -> Type) (f :: Type -> Type). QualIdent l' -> Designator Language l' f' f #

field :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> Ident -> Designator Language l' f' f #

index :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> NonEmpty (f (Expression l' l' f' f')) -> Designator Language l' f' f #

dereference :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> Designator Language l' f' f #

identDef :: Ident -> IdentDef Language #

nonQualIdent :: Ident -> QualIdent Language #

Wirthy l => Wirthy (WirthySubsetOf l) 
Instance details

Defined in Language.Oberon.Abstract

Associated Types

type Module (WirthySubsetOf l) = (m :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Declaration (WirthySubsetOf l) = (d :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Type (WirthySubsetOf l) = (t :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Statement (WirthySubsetOf l) = (s :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Expression (WirthySubsetOf l) = (e :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Designator (WirthySubsetOf l) = (d :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Value (WirthySubsetOf l) = (v :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type FieldList (WirthySubsetOf l) = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type ProcedureHeading (WirthySubsetOf l) = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type FormalParameters (WirthySubsetOf l) = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type FPSection (WirthySubsetOf l) = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Block (WirthySubsetOf l) = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type StatementSequence (WirthySubsetOf l) = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Case (WirthySubsetOf l) = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type CaseLabels (WirthySubsetOf l) = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type ConditionalBranch (WirthySubsetOf l) = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Element (WirthySubsetOf l) = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Import (WirthySubsetOf l) = (x :: Type) #

type IdentDef (WirthySubsetOf l) = (x :: Type) #

type QualIdent (WirthySubsetOf l) = (x :: Type) #

Methods

constantDeclaration :: forall l' f (f' :: Type -> Type). IdentDef l' -> f (ConstExpression l' l' f' f') -> Declaration (WirthySubsetOf l) l' f' f #

typeDeclaration :: forall l' f (f' :: Type -> Type). IdentDef l' -> f (Type l' l' f' f') -> Declaration (WirthySubsetOf l) l' f' f #

variableDeclaration :: forall l' f (f' :: Type -> Type). IdentList l' -> f (Type l' l' f' f') -> Declaration (WirthySubsetOf l) l' f' f #

procedureDeclaration :: forall f l' (f' :: Type -> Type). f (ProcedureHeading l' l' f' f') -> f (Block l' l' f' f') -> Declaration (WirthySubsetOf l) l' f' f #

formalParameters :: forall f l' (f' :: Type -> Type). [f (FPSection l' l' f' f')] -> Maybe (ReturnType l') -> FormalParameters (WirthySubsetOf l) l' f' f #

fpSection :: forall f l' (f' :: Type -> Type). Bool -> [Ident] -> f (Type l' l' f' f') -> FPSection (WirthySubsetOf l) l' f' f #

block :: forall f l' (f' :: Type -> Type). [f (Declaration l' l' f' f')] -> Maybe (f (StatementSequence l' l' f' f')) -> Block (WirthySubsetOf l) l' f' f #

fieldList :: forall l' f (f' :: Type -> Type). NonEmpty (IdentDef l') -> f (Type l' l' f' f') -> FieldList (WirthySubsetOf l) l' f' f #

pointerType :: forall f l' (f' :: Type -> Type). f (Type l' l' f' f') -> Type (WirthySubsetOf l) l' f' f #

procedureType :: forall f l' (f' :: Type -> Type). Maybe (f (FormalParameters l' l' f' f')) -> Type (WirthySubsetOf l) l' f' f #

typeReference :: forall l' (f' :: Type -> Type) (f :: Type -> Type). QualIdent l' -> Type (WirthySubsetOf l) l' f' f #

assignment :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> f (Expression l' l' f' f') -> Statement (WirthySubsetOf l) l' f' f #

caseStatement :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> [f (Case l' l' f' f')] -> Maybe (f (StatementSequence l' l' f' f')) -> Statement (WirthySubsetOf l) l' f' f #

emptyStatement :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Statement (WirthySubsetOf l) l' f' f #

exitStatement :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Statement (WirthySubsetOf l) l' f' f #

ifStatement :: forall f l' (f' :: Type -> Type). NonEmpty (f (ConditionalBranch l' l' f' f')) -> Maybe (f (StatementSequence l' l' f' f')) -> Statement (WirthySubsetOf l) l' f' f #

loopStatement :: forall f l' (f' :: Type -> Type). f (StatementSequence l' l' f' f') -> Statement (WirthySubsetOf l) l' f' f #

procedureCall :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> Maybe [f (Expression l' l' f' f')] -> Statement (WirthySubsetOf l) l' f' f #

repeatStatement :: forall f l' (f' :: Type -> Type). f (StatementSequence l' l' f' f') -> f (Expression l' l' f' f') -> Statement (WirthySubsetOf l) l' f' f #

returnStatement :: forall f l' (f' :: Type -> Type). Maybe (f (Expression l' l' f' f')) -> Statement (WirthySubsetOf l) l' f' f #

whileStatement :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (StatementSequence l' l' f' f') -> Statement (WirthySubsetOf l) l' f' f #

conditionalBranch :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (StatementSequence l' l' f' f') -> ConditionalBranch (WirthySubsetOf l) l' f' f #

caseAlternative :: forall f l' (f' :: Type -> Type). NonEmpty (f (CaseLabels l' l' f' f')) -> f (StatementSequence l' l' f' f') -> Case (WirthySubsetOf l) l' f' f #

singleLabel :: forall f l' (f' :: Type -> Type). f (ConstExpression l' l' f' f') -> CaseLabels (WirthySubsetOf l) l' f' f #

labelRange :: forall f l' (f' :: Type -> Type). f (ConstExpression l' l' f' f') -> f (ConstExpression l' l' f' f') -> CaseLabels (WirthySubsetOf l) l' f' f #

statementSequence :: forall f l' (f' :: Type -> Type). [f (Statement l' l' f' f')] -> StatementSequence (WirthySubsetOf l) l' f' f #

add :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression (WirthySubsetOf l) l' f' f #

subtract :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression (WirthySubsetOf l) l' f' f #

and :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression (WirthySubsetOf l) l' f' f #

or :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression (WirthySubsetOf l) l' f' f #

divide :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression (WirthySubsetOf l) l' f' f #

integerDivide :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression (WirthySubsetOf l) l' f' f #

modulo :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression (WirthySubsetOf l) l' f' f #

multiply :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression (WirthySubsetOf l) l' f' f #

functionCall :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> [f (Expression l' l' f' f')] -> Expression (WirthySubsetOf l) l' f' f #

literal :: forall f l' (f' :: Type -> Type). f (Value l' l' f' f') -> Expression (WirthySubsetOf l) l' f' f #

negative :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> Expression (WirthySubsetOf l) l' f' f #

positive :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> Expression (WirthySubsetOf l) l' f' f #

not :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> Expression (WirthySubsetOf l) l' f' f #

read :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> Expression (WirthySubsetOf l) l' f' f #

relation :: forall f l' (f' :: Type -> Type). RelOp -> f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression (WirthySubsetOf l) l' f' f #

element :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> Element (WirthySubsetOf l) l' f' f #

range :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Element (WirthySubsetOf l) l' f' f #

integer :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Integer -> Value (WirthySubsetOf l) l' f' f #

nil :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Value (WirthySubsetOf l) l' f' f #

false :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Value (WirthySubsetOf l) l' f' f #

true :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Value (WirthySubsetOf l) l' f' f #

real :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Double -> Value (WirthySubsetOf l) l' f' f #

string :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Text -> Value (WirthySubsetOf l) l' f' f #

charCode :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Int -> Value (WirthySubsetOf l) l' f' f #

builtin :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Text -> Value (WirthySubsetOf l) l' f' f #

variable :: forall l' (f' :: Type -> Type) (f :: Type -> Type). QualIdent l' -> Designator (WirthySubsetOf l) l' f' f #

field :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> Ident -> Designator (WirthySubsetOf l) l' f' f #

index :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> NonEmpty (f (Expression l' l' f' f')) -> Designator (WirthySubsetOf l) l' f' f #

dereference :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> Designator (WirthySubsetOf l) l' f' f #

identDef :: Ident -> IdentDef (WirthySubsetOf l) #

nonQualIdent :: Ident -> QualIdent (WirthySubsetOf l) #

class Wirthy l => CoWirthy l where #

An instance of this type can convert its own constructs to another language that's an instance of TargetClass.

Associated Types

type TargetClass l :: Type -> Constraint #

Methods

coDeclaration :: forall l' l'' (f' :: Type -> Type) (f :: Type -> Type). TargetClass l l' => Declaration l l'' f' f -> Declaration l' l'' f' f #

coType :: forall l' l'' (f' :: Type -> Type) (f :: Type -> Type). TargetClass l l' => Type l l'' f' f -> Type l' l'' f' f #

coStatement :: forall l' l'' (f' :: Type -> Type) (f :: Type -> Type). TargetClass l l' => Statement l l'' f' f -> Statement l' l'' f' f #

coExpression :: forall l' l'' (f' :: Type -> Type) (f :: Type -> Type). TargetClass l l' => Expression l l'' f' f -> Expression l' l'' f' f #

coDesignator :: forall l' l'' (f' :: Type -> Type) (f :: Type -> Type). TargetClass l l' => Designator l l'' f' f -> Designator l' l'' f' f #

coValue :: forall l' l'' (f' :: Type -> Type) (f :: Type -> Type). TargetClass l l' => Value l l'' f' f -> Value l' l'' f' f #

Instances

Instances details
CoWirthy Language Source # 
Instance details

Defined in Language.Modula2.AST

Associated Types

type TargetClass Language :: Type -> Constraint #

Methods

coDeclaration :: forall l' l'' (f' :: Type -> Type) (f :: Type -> Type). TargetClass Language l' => Declaration Language l'' f' f -> Declaration l' l'' f' f #

coType :: forall l' l'' (f' :: Type -> Type) (f :: Type -> Type). TargetClass Language l' => Type Language l'' f' f -> Type l' l'' f' f #

coStatement :: forall l' l'' (f' :: Type -> Type) (f :: Type -> Type). TargetClass Language l' => Statement Language l'' f' f -> Statement l' l'' f' f #

coExpression :: forall l' l'' (f' :: Type -> Type) (f :: Type -> Type). TargetClass Language l' => Expression Language l'' f' f -> Expression l' l'' f' f #

coDesignator :: forall l' l'' (f' :: Type -> Type) (f :: Type -> Type). TargetClass Language l' => Designator Language l'' f' f -> Designator l' l'' f' f #

coValue :: forall l' l'' (f' :: Type -> Type) (f :: Type -> Type). TargetClass Language l' => Value Language l'' f' f -> Value l' l'' f' f #

CoWirthy Language Source # 
Instance details

Defined in Language.Modula2.ISO.AST

Associated Types

type TargetClass Language :: Type -> Constraint #

Methods

coDeclaration :: forall l' l'' (f' :: Type -> Type) (f :: Type -> Type). TargetClass Language l' => Declaration Language l'' f' f -> Declaration l' l'' f' f #

coType :: forall l' l'' (f' :: Type -> Type) (f :: Type -> Type). TargetClass Language l' => Type Language l'' f' f -> Type l' l'' f' f #

coStatement :: forall l' l'' (f' :: Type -> Type) (f :: Type -> Type). TargetClass Language l' => Statement Language l'' f' f -> Statement l' l'' f' f #

coExpression :: forall l' l'' (f' :: Type -> Type) (f :: Type -> Type). TargetClass Language l' => Expression Language l'' f' f -> Expression l' l'' f' f #

coDesignator :: forall l' l'' (f' :: Type -> Type) (f :: Type -> Type). TargetClass Language l' => Designator Language l'' f' f -> Designator l' l'' f' f #

coValue :: forall l' l'' (f' :: Type -> Type) (f :: Type -> Type). TargetClass Language l' => Value Language l'' f' f -> Value l' l'' f' f #

CoWirthy Language 
Instance details

Defined in Language.Oberon.AST

Associated Types

type TargetClass Language :: Type -> Constraint #

Methods

coDeclaration :: forall l' l'' (f' :: Type -> Type) (f :: Type -> Type). TargetClass Language l' => Declaration Language l'' f' f -> Declaration l' l'' f' f #

coType :: forall l' l'' (f' :: Type -> Type) (f :: Type -> Type). TargetClass Language l' => Type Language l'' f' f -> Type l' l'' f' f #

coStatement :: forall l' l'' (f' :: Type -> Type) (f :: Type -> Type). TargetClass Language l' => Statement Language l'' f' f -> Statement l' l'' f' f #

coExpression :: forall l' l'' (f' :: Type -> Type) (f :: Type -> Type). TargetClass Language l' => Expression Language l'' f' f -> Expression l' l'' f' f #

coDesignator :: forall l' l'' (f' :: Type -> Type) (f :: Type -> Type). TargetClass Language l' => Designator Language l'' f' f -> Designator l' l'' f' f #

coValue :: forall l' l'' (f' :: Type -> Type) (f :: Type -> Type). TargetClass Language l' => Value Language l'' f' f -> Value l' l'' f' f #

class Wirthy l => Nameable l where #

Ability to deconstruct named constructs and obtain their Ident.

Methods

getProcedureName :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Nameable l' => ProcedureHeading l l' f' f -> Ident #

getIdentDefName :: IdentDef l -> Ident #

getNonQualIdentName :: QualIdent l -> Maybe Ident #

Instances

Instances details
Nameable Language Source # 
Instance details

Defined in Language.Modula2.AST

Nameable Language Source # 
Instance details

Defined in Language.Modula2.ISO.AST

Nameable Language 
Instance details

Defined in Language.Oberon.AST

class Wirthy l => Modula2 l where Source #

The finally-tagless associated types and methods relevant to the Modula-2 language. Every non-leaf node type has four type variables:

  • type variable l represents the language of the constructs built by the methods,
  • l' is the language of the child node constructs,
  • f' wraps all descendant nodes, except
  • f wraps all direct children of the node.

Associated Types

type Export l = x | x -> l Source #

type Definition l = (d :: * -> (* -> *) -> (* -> *) -> *) | d -> l Source #

type Variant l = (v :: * -> (* -> *) -> (* -> *) -> *) | v -> l Source #

Methods

definitionModule :: Ident -> [Import l'] -> Maybe (Export l') -> [f (Definition l' l' f' f')] -> Module l l' f' f Source #

implementationModule :: Ident -> Maybe (f (Priority l' l' f' f')) -> [Import l'] -> f (Block l' l' f' f') -> Module l l' f' f Source #

programModule :: Ident -> Maybe (f (Priority l' l' f' f')) -> [Import l'] -> f (Block l' l' f' f') -> Module l l' f' f Source #

moduleExport :: Bool -> NonEmpty Ident -> Export l Source #

moduleImport :: Maybe Ident -> NonEmpty Ident -> Import l Source #

constantDefinition :: IdentDef l' -> f (ConstExpression l' l' f' f') -> Definition l l' f' f Source #

typeDefinition :: IdentDef l' -> Maybe (f (Type l' l' f' f')) -> Definition l l' f' f Source #

variableDefinition :: IdentList l' -> f (Type l' l' f' f') -> Definition l l' f' f Source #

procedureDefinition :: f (ProcedureHeading l' l' f' f') -> Definition l l' f' f Source #

moduleDeclaration :: Ident -> Maybe (f (Priority l' l' f' f')) -> [Import l'] -> Maybe (Export l') -> f (Block l' l' f' f') -> Declaration l l' f' f Source #

procedureHeading :: Ident -> Maybe (f (FormalParameters l' l' f' f')) -> ProcedureHeading l l' f' f Source #

caseFieldList :: Maybe Ident -> QualIdent l' -> NonEmpty (f (Variant l' l' f' f')) -> [f (FieldList l' l' f' f')] -> FieldList l l' f' f Source #

variant :: NonEmpty (f (CaseLabels l' l' f' f')) -> [f (FieldList l' l' f' f')] -> Variant l l' f' f Source #

enumeration :: IdentList l' -> Type l l' f' f Source #

subRange :: Maybe (QualIdent l') -> f (ConstExpression l' l' f' f') -> f (ConstExpression l' l' f' f') -> Type l l' f' f Source #

arrayType :: [f (Type l' l' f' f')] -> f (Type l' l' f' f') -> Type l l' f' f Source #

setType :: f (Type l' l' f' f') -> Type l l' f' f Source #

recordType :: [f (FieldList l' l' f' f')] -> Type l l' f' f Source #

withStatement :: f (Designator l' l' f' f') -> f (StatementSequence l' l' f' f') -> Statement l l' f' f Source #

forStatement :: Ident -> f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Maybe (f (Expression l' l' f' f')) -> f (StatementSequence l' l' f' f') -> Statement l l' f' f Source #

set :: Maybe (QualIdent l') -> [f (Element l' l' f' f')] -> Expression l l' f' f Source #

qualIdent :: [Ident] -> Ident -> QualIdent l Source #

Instances

Instances details
Modula2 Language Source # 
Instance details

Defined in Language.Modula2.AST

Associated Types

type Export Language = (x :: Type) Source #

type Definition Language = (d :: Type -> (Type -> Type) -> (Type -> Type) -> Type) Source #

type Variant Language = (v :: Type -> (Type -> Type) -> (Type -> Type) -> Type) Source #

Methods

definitionModule :: forall l' f (f' :: Type -> Type). Ident -> [Import l'] -> Maybe (Export l') -> [f (Definition l' l' f' f')] -> Module Language l' f' f Source #

implementationModule :: forall f l' (f' :: Type -> Type). Ident -> Maybe (f (Priority l' l' f' f')) -> [Import l'] -> f (Block l' l' f' f') -> Module Language l' f' f Source #

programModule :: forall f l' (f' :: Type -> Type). Ident -> Maybe (f (Priority l' l' f' f')) -> [Import l'] -> f (Block l' l' f' f') -> Module Language l' f' f Source #

moduleExport :: Bool -> NonEmpty Ident -> Export Language Source #

moduleImport :: Maybe Ident -> NonEmpty Ident -> Import Language Source #

constantDefinition :: forall l' f (f' :: Type -> Type). IdentDef l' -> f (ConstExpression l' l' f' f') -> Definition Language l' f' f Source #

typeDefinition :: forall l' f (f' :: Type -> Type). IdentDef l' -> Maybe (f (Type l' l' f' f')) -> Definition Language l' f' f Source #

variableDefinition :: forall l' f (f' :: Type -> Type). IdentList l' -> f (Type l' l' f' f') -> Definition Language l' f' f Source #

procedureDefinition :: forall f l' (f' :: Type -> Type). f (ProcedureHeading l' l' f' f') -> Definition Language l' f' f Source #

moduleDeclaration :: forall f l' (f' :: Type -> Type). Ident -> Maybe (f (Priority l' l' f' f')) -> [Import l'] -> Maybe (Export l') -> f (Block l' l' f' f') -> Declaration Language l' f' f Source #

procedureHeading :: forall f l' (f' :: Type -> Type). Ident -> Maybe (f (FormalParameters l' l' f' f')) -> ProcedureHeading Language l' f' f Source #

caseFieldList :: forall l' f (f' :: Type -> Type). Maybe Ident -> QualIdent l' -> NonEmpty (f (Variant l' l' f' f')) -> [f (FieldList l' l' f' f')] -> FieldList Language l' f' f Source #

variant :: forall f l' (f' :: Type -> Type). NonEmpty (f (CaseLabels l' l' f' f')) -> [f (FieldList l' l' f' f')] -> Variant Language l' f' f Source #

enumeration :: forall l' (f' :: Type -> Type) (f :: Type -> Type). IdentList l' -> Type Language l' f' f Source #

subRange :: forall l' f (f' :: Type -> Type). Maybe (QualIdent l') -> f (ConstExpression l' l' f' f') -> f (ConstExpression l' l' f' f') -> Type Language l' f' f Source #

arrayType :: forall f l' (f' :: Type -> Type). [f (Type l' l' f' f')] -> f (Type l' l' f' f') -> Type Language l' f' f Source #

setType :: forall f l' (f' :: Type -> Type). f (Type l' l' f' f') -> Type Language l' f' f Source #

recordType :: forall f l' (f' :: Type -> Type). [f (FieldList l' l' f' f')] -> Type Language l' f' f Source #

withStatement :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> f (StatementSequence l' l' f' f') -> Statement Language l' f' f Source #

forStatement :: forall f l' (f' :: Type -> Type). Ident -> f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Maybe (f (Expression l' l' f' f')) -> f (StatementSequence l' l' f' f') -> Statement Language l' f' f Source #

set :: forall l' f (f' :: Type -> Type). Maybe (QualIdent l') -> [f (Element l' l' f' f')] -> Expression Language l' f' f Source #

qualIdent :: [Ident] -> Ident -> QualIdent Language Source #

Modula2 Language Source # 
Instance details

Defined in Language.Modula2.ISO.AST

Associated Types

type Export Language = (x :: Type) Source #

type Definition Language = (d :: Type -> (Type -> Type) -> (Type -> Type) -> Type) Source #

type Variant Language = (v :: Type -> (Type -> Type) -> (Type -> Type) -> Type) Source #

Methods

definitionModule :: forall l' f (f' :: Type -> Type). Ident -> [Import l'] -> Maybe (Export l') -> [f (Definition l' l' f' f')] -> Module Language l' f' f Source #

implementationModule :: forall f l' (f' :: Type -> Type). Ident -> Maybe (f (Priority l' l' f' f')) -> [Import l'] -> f (Block l' l' f' f') -> Module Language l' f' f Source #

programModule :: forall f l' (f' :: Type -> Type). Ident -> Maybe (f (Priority l' l' f' f')) -> [Import l'] -> f (Block l' l' f' f') -> Module Language l' f' f Source #

moduleExport :: Bool -> NonEmpty Ident -> Export Language Source #

moduleImport :: Maybe Ident -> NonEmpty Ident -> Import Language Source #

constantDefinition :: forall l' f (f' :: Type -> Type). IdentDef l' -> f (ConstExpression l' l' f' f') -> Definition Language l' f' f Source #

typeDefinition :: forall l' f (f' :: Type -> Type). IdentDef l' -> Maybe (f (Type l' l' f' f')) -> Definition Language l' f' f Source #

variableDefinition :: forall l' f (f' :: Type -> Type). IdentList l' -> f (Type l' l' f' f') -> Definition Language l' f' f Source #

procedureDefinition :: forall f l' (f' :: Type -> Type). f (ProcedureHeading l' l' f' f') -> Definition Language l' f' f Source #

moduleDeclaration :: forall f l' (f' :: Type -> Type). Ident -> Maybe (f (Priority l' l' f' f')) -> [Import l'] -> Maybe (Export l') -> f (Block l' l' f' f') -> Declaration Language l' f' f Source #

procedureHeading :: forall f l' (f' :: Type -> Type). Ident -> Maybe (f (FormalParameters l' l' f' f')) -> ProcedureHeading Language l' f' f Source #

caseFieldList :: forall l' f (f' :: Type -> Type). Maybe Ident -> QualIdent l' -> NonEmpty (f (Variant l' l' f' f')) -> [f (FieldList l' l' f' f')] -> FieldList Language l' f' f Source #

variant :: forall f l' (f' :: Type -> Type). NonEmpty (f (CaseLabels l' l' f' f')) -> [f (FieldList l' l' f' f')] -> Variant Language l' f' f Source #

enumeration :: forall l' (f' :: Type -> Type) (f :: Type -> Type). IdentList l' -> Type Language l' f' f Source #

subRange :: forall l' f (f' :: Type -> Type). Maybe (QualIdent l') -> f (ConstExpression l' l' f' f') -> f (ConstExpression l' l' f' f') -> Type Language l' f' f Source #

arrayType :: forall f l' (f' :: Type -> Type). [f (Type l' l' f' f')] -> f (Type l' l' f' f') -> Type Language l' f' f Source #

setType :: forall f l' (f' :: Type -> Type). f (Type l' l' f' f') -> Type Language l' f' f Source #

recordType :: forall f l' (f' :: Type -> Type). [f (FieldList l' l' f' f')] -> Type Language l' f' f Source #

withStatement :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> f (StatementSequence l' l' f' f') -> Statement Language l' f' f Source #

forStatement :: forall f l' (f' :: Type -> Type). Ident -> f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Maybe (f (Expression l' l' f' f')) -> f (StatementSequence l' l' f' f') -> Statement Language l' f' f Source #

set :: forall l' f (f' :: Type -> Type). Maybe (QualIdent l') -> [f (Element l' l' f' f')] -> Expression Language l' f' f Source #

qualIdent :: [Ident] -> Ident -> QualIdent Language Source #

Wirthy l => Modula2 (WirthySubsetOf l) Source # 
Instance details

Defined in Language.Modula2.Abstract

Associated Types

type Export (WirthySubsetOf l) = (x :: Type) Source #

type Definition (WirthySubsetOf l) = (d :: Type -> (Type -> Type) -> (Type -> Type) -> Type) Source #

type Variant (WirthySubsetOf l) = (v :: Type -> (Type -> Type) -> (Type -> Type) -> Type) Source #

Methods

definitionModule :: forall l' f (f' :: Type -> Type). Ident -> [Import l'] -> Maybe (Export l') -> [f (Definition l' l' f' f')] -> Module (WirthySubsetOf l) l' f' f Source #

implementationModule :: forall f l' (f' :: Type -> Type). Ident -> Maybe (f (Priority l' l' f' f')) -> [Import l'] -> f (Block l' l' f' f') -> Module (WirthySubsetOf l) l' f' f Source #

programModule :: forall f l' (f' :: Type -> Type). Ident -> Maybe (f (Priority l' l' f' f')) -> [Import l'] -> f (Block l' l' f' f') -> Module (WirthySubsetOf l) l' f' f Source #

moduleExport :: Bool -> NonEmpty Ident -> Export (WirthySubsetOf l) Source #

moduleImport :: Maybe Ident -> NonEmpty Ident -> Import (WirthySubsetOf l) Source #

constantDefinition :: forall l' f (f' :: Type -> Type). IdentDef l' -> f (ConstExpression l' l' f' f') -> Definition (WirthySubsetOf l) l' f' f Source #

typeDefinition :: forall l' f (f' :: Type -> Type). IdentDef l' -> Maybe (f (Type l' l' f' f')) -> Definition (WirthySubsetOf l) l' f' f Source #

variableDefinition :: forall l' f (f' :: Type -> Type). IdentList l' -> f (Type l' l' f' f') -> Definition (WirthySubsetOf l) l' f' f Source #

procedureDefinition :: forall f l' (f' :: Type -> Type). f (ProcedureHeading l' l' f' f') -> Definition (WirthySubsetOf l) l' f' f Source #

moduleDeclaration :: forall f l' (f' :: Type -> Type). Ident -> Maybe (f (Priority l' l' f' f')) -> [Import l'] -> Maybe (Export l') -> f (Block l' l' f' f') -> Declaration (WirthySubsetOf l) l' f' f Source #

procedureHeading :: forall f l' (f' :: Type -> Type). Ident -> Maybe (f (FormalParameters l' l' f' f')) -> ProcedureHeading (WirthySubsetOf l) l' f' f Source #

caseFieldList :: forall l' f (f' :: Type -> Type). Maybe Ident -> QualIdent l' -> NonEmpty (f (Variant l' l' f' f')) -> [f (FieldList l' l' f' f')] -> FieldList (WirthySubsetOf l) l' f' f Source #

variant :: forall f l' (f' :: Type -> Type). NonEmpty (f (CaseLabels l' l' f' f')) -> [f (FieldList l' l' f' f')] -> Variant (WirthySubsetOf l) l' f' f Source #

enumeration :: forall l' (f' :: Type -> Type) (f :: Type -> Type). IdentList l' -> Type (WirthySubsetOf l) l' f' f Source #

subRange :: forall l' f (f' :: Type -> Type). Maybe (QualIdent l') -> f (ConstExpression l' l' f' f') -> f (ConstExpression l' l' f' f') -> Type (WirthySubsetOf l) l' f' f Source #

arrayType :: forall f l' (f' :: Type -> Type). [f (Type l' l' f' f')] -> f (Type l' l' f' f') -> Type (WirthySubsetOf l) l' f' f Source #

setType :: forall f l' (f' :: Type -> Type). f (Type l' l' f' f') -> Type (WirthySubsetOf l) l' f' f Source #

recordType :: forall f l' (f' :: Type -> Type). [f (FieldList l' l' f' f')] -> Type (WirthySubsetOf l) l' f' f Source #

withStatement :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> f (StatementSequence l' l' f' f') -> Statement (WirthySubsetOf l) l' f' f Source #

forStatement :: forall f l' (f' :: Type -> Type). Ident -> f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Maybe (f (Expression l' l' f' f')) -> f (StatementSequence l' l' f' f') -> Statement (WirthySubsetOf l) l' f' f Source #

set :: forall l' f (f' :: Type -> Type). Maybe (QualIdent l') -> [f (Element l' l' f' f')] -> Expression (WirthySubsetOf l) l' f' f Source #

qualIdent :: [Ident] -> Ident -> QualIdent (WirthySubsetOf l) Source #

data RelOp #

Relational operators

Instances

Instances details
Data RelOp 
Instance details

Defined in Language.Oberon.Abstract

Methods

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

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

toConstr :: RelOp -> Constr #

dataTypeOf :: RelOp -> DataType #

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

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

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

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

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

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

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

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

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

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

Show RelOp 
Instance details

Defined in Language.Oberon.Abstract

Methods

showsPrec :: Int -> RelOp -> ShowS #

show :: RelOp -> String #

showList :: [RelOp] -> ShowS #

Eq RelOp 
Instance details

Defined in Language.Oberon.Abstract

Methods

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

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

data WirthySubsetOf l #

A language with constructs beyond the base Wirthy class will have constructs that cannot be converted to a | Wirthy target. It can declare its TargetClass to be this transformed language instead, whose language | constructs are all wrapped in Maybe or Maybe3.

Constructors

WirthySubsetOf l 

Instances

Instances details
Wirthy l => Modula2 (WirthySubsetOf l) Source # 
Instance details

Defined in Language.Modula2.Abstract

Associated Types

type Export (WirthySubsetOf l) = (x :: Type) Source #

type Definition (WirthySubsetOf l) = (d :: Type -> (Type -> Type) -> (Type -> Type) -> Type) Source #

type Variant (WirthySubsetOf l) = (v :: Type -> (Type -> Type) -> (Type -> Type) -> Type) Source #

Methods

definitionModule :: forall l' f (f' :: Type -> Type). Ident -> [Import l'] -> Maybe (Export l') -> [f (Definition l' l' f' f')] -> Module (WirthySubsetOf l) l' f' f Source #

implementationModule :: forall f l' (f' :: Type -> Type). Ident -> Maybe (f (Priority l' l' f' f')) -> [Import l'] -> f (Block l' l' f' f') -> Module (WirthySubsetOf l) l' f' f Source #

programModule :: forall f l' (f' :: Type -> Type). Ident -> Maybe (f (Priority l' l' f' f')) -> [Import l'] -> f (Block l' l' f' f') -> Module (WirthySubsetOf l) l' f' f Source #

moduleExport :: Bool -> NonEmpty Ident -> Export (WirthySubsetOf l) Source #

moduleImport :: Maybe Ident -> NonEmpty Ident -> Import (WirthySubsetOf l) Source #

constantDefinition :: forall l' f (f' :: Type -> Type). IdentDef l' -> f (ConstExpression l' l' f' f') -> Definition (WirthySubsetOf l) l' f' f Source #

typeDefinition :: forall l' f (f' :: Type -> Type). IdentDef l' -> Maybe (f (Type l' l' f' f')) -> Definition (WirthySubsetOf l) l' f' f Source #

variableDefinition :: forall l' f (f' :: Type -> Type). IdentList l' -> f (Type l' l' f' f') -> Definition (WirthySubsetOf l) l' f' f Source #

procedureDefinition :: forall f l' (f' :: Type -> Type). f (ProcedureHeading l' l' f' f') -> Definition (WirthySubsetOf l) l' f' f Source #

moduleDeclaration :: forall f l' (f' :: Type -> Type). Ident -> Maybe (f (Priority l' l' f' f')) -> [Import l'] -> Maybe (Export l') -> f (Block l' l' f' f') -> Declaration (WirthySubsetOf l) l' f' f Source #

procedureHeading :: forall f l' (f' :: Type -> Type). Ident -> Maybe (f (FormalParameters l' l' f' f')) -> ProcedureHeading (WirthySubsetOf l) l' f' f Source #

caseFieldList :: forall l' f (f' :: Type -> Type). Maybe Ident -> QualIdent l' -> NonEmpty (f (Variant l' l' f' f')) -> [f (FieldList l' l' f' f')] -> FieldList (WirthySubsetOf l) l' f' f Source #

variant :: forall f l' (f' :: Type -> Type). NonEmpty (f (CaseLabels l' l' f' f')) -> [f (FieldList l' l' f' f')] -> Variant (WirthySubsetOf l) l' f' f Source #

enumeration :: forall l' (f' :: Type -> Type) (f :: Type -> Type). IdentList l' -> Type (WirthySubsetOf l) l' f' f Source #

subRange :: forall l' f (f' :: Type -> Type). Maybe (QualIdent l') -> f (ConstExpression l' l' f' f') -> f (ConstExpression l' l' f' f') -> Type (WirthySubsetOf l) l' f' f Source #

arrayType :: forall f l' (f' :: Type -> Type). [f (Type l' l' f' f')] -> f (Type l' l' f' f') -> Type (WirthySubsetOf l) l' f' f Source #

setType :: forall f l' (f' :: Type -> Type). f (Type l' l' f' f') -> Type (WirthySubsetOf l) l' f' f Source #

recordType :: forall f l' (f' :: Type -> Type). [f (FieldList l' l' f' f')] -> Type (WirthySubsetOf l) l' f' f Source #

withStatement :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> f (StatementSequence l' l' f' f') -> Statement (WirthySubsetOf l) l' f' f Source #

forStatement :: forall f l' (f' :: Type -> Type). Ident -> f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Maybe (f (Expression l' l' f' f')) -> f (StatementSequence l' l' f' f') -> Statement (WirthySubsetOf l) l' f' f Source #

set :: forall l' f (f' :: Type -> Type). Maybe (QualIdent l') -> [f (Element l' l' f' f')] -> Expression (WirthySubsetOf l) l' f' f Source #

qualIdent :: [Ident] -> Ident -> QualIdent (WirthySubsetOf l) Source #

Wirthy l => Modula2 (WirthySubsetOf l) Source # 
Instance details

Defined in Language.Modula2.ISO.Abstract

Associated Types

type AddressedIdent (WirthySubsetOf l) = (d :: Type -> (Type -> Type) -> (Type -> Type) -> Type) Source #

type Item (WirthySubsetOf l) = (i :: Type -> (Type -> Type) -> (Type -> Type) -> Type) Source #

Methods

emptyVariant :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Variant (WirthySubsetOf l) l' f' f Source #

addressedVariableDeclaration :: forall f l' (f' :: Type -> Type). NonEmpty (f (AddressedIdent l' l' f' f')) -> f (Type l' l' f' f') -> Declaration (WirthySubsetOf l) l' f' f Source #

forwardProcedureDeclaration :: forall f l' (f' :: Type -> Type). f (ProcedureHeading l' l' f' f') -> Declaration (WirthySubsetOf l) l' f' f Source #

exceptionHandlingBlock :: forall f l' (f' :: Type -> Type). [f (Declaration l' l' f' f')] -> Maybe (f (StatementSequence l' l' f' f')) -> Maybe (f (StatementSequence l' l' f' f')) -> Maybe (f (StatementSequence l' l' f' f')) -> Block (WirthySubsetOf l) l' f' f Source #

addressedIdent :: forall f l' (f' :: Type -> Type). Ident -> f (ConstExpression l' l' f' f') -> AddressedIdent (WirthySubsetOf l) l' f' f Source #

unaddressedIdent :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Ident -> AddressedIdent (WirthySubsetOf l) l' f' f Source #

packedSetType :: forall f l' (f' :: Type -> Type). f (Type l' l' f' f') -> Type (WirthySubsetOf l) l' f' f Source #

retryStatement :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Statement (WirthySubsetOf l) l' f' f Source #

array :: forall l' f (f' :: Type -> Type). Maybe (QualIdent l') -> [f (Item l' l' f' f')] -> Expression (WirthySubsetOf l) l' f' f Source #

record :: forall l' f (f' :: Type -> Type). Maybe (QualIdent l') -> [f (Expression l' l' f' f')] -> Expression (WirthySubsetOf l) l' f' f Source #

remainder :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression (WirthySubsetOf l) l' f' f Source #

single :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> Item (WirthySubsetOf l) l' f' f Source #

repeated :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (ConstExpression l' l' f' f') -> Item (WirthySubsetOf l) l' f' f Source #

Wirthy l => Oberon (WirthySubsetOf l) 
Instance details

Defined in Language.Oberon.Abstract

Associated Types

type WithAlternative (WirthySubsetOf l) = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

Methods

moduleUnit :: forall f l' (f' :: Type -> Type). Ident -> [Import (WirthySubsetOf l)] -> f (Block l' l' f' f') -> Module (WirthySubsetOf l) l' f' f #

moduleImport :: Maybe Ident -> Ident -> Import (WirthySubsetOf l) #

qualIdent :: Ident -> Ident -> QualIdent (WirthySubsetOf l) #

getQualIdentNames :: QualIdent (WirthySubsetOf l) -> Maybe (Ident, Ident) #

exported :: Ident -> IdentDef (WirthySubsetOf l) #

forwardDeclaration :: forall l' f (f' :: Type -> Type). IdentDef l' -> Maybe (f (FormalParameters l' l' f' f')) -> Declaration (WirthySubsetOf l) l' f' f #

procedureHeading :: forall l' f (f' :: Type -> Type). Bool -> IdentDef l' -> Maybe (f (FormalParameters l' l' f' f')) -> ProcedureHeading (WirthySubsetOf l) l' f' f #

arrayType :: forall f l' (f' :: Type -> Type). [f (ConstExpression l' l' f' f')] -> f (Type l' l' f' f') -> Type (WirthySubsetOf l) l' f' f #

recordType :: forall l' f (f' :: Type -> Type). Maybe (BaseType l') -> [f (FieldList l' l' f' f')] -> Type (WirthySubsetOf l) l' f' f #

withStatement :: forall f l' (f' :: Type -> Type). f (WithAlternative l' l' f' f') -> Statement (WirthySubsetOf l) l' f' f #

withAlternative :: forall l' f (f' :: Type -> Type). QualIdent l' -> QualIdent l' -> f (StatementSequence l' l' f' f') -> WithAlternative (WirthySubsetOf l) l' f' f #

is :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> QualIdent l' -> Expression (WirthySubsetOf l) l' f' f #

set :: forall f l' (f' :: Type -> Type). [f (Element l' l' f' f')] -> Expression (WirthySubsetOf l) l' f' f #

typeGuard :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> QualIdent l' -> Designator (WirthySubsetOf l) l' f' f #

Wirthy l => Oberon2 (WirthySubsetOf l) 
Instance details

Defined in Language.Oberon.Abstract

Methods

readOnly :: Ident -> IdentDef (WirthySubsetOf l) #

typeBoundHeading :: forall l' f (f' :: Type -> Type). Bool -> Ident -> Ident -> Bool -> IdentDef l' -> Maybe (f (FormalParameters l' l' f' f')) -> ProcedureHeading (WirthySubsetOf l) l' f' f #

forStatement :: forall f l' (f' :: Type -> Type). Ident -> f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Maybe (f (Expression l' l' f' f')) -> f (StatementSequence l' l' f' f') -> Statement (WirthySubsetOf l) l' f' f #

variantWithStatement :: forall f l' (f' :: Type -> Type). NonEmpty (f (WithAlternative l' l' f' f')) -> Maybe (f (StatementSequence l' l' f' f')) -> Statement (WirthySubsetOf l) l' f' f #

Wirthy l => Wirthy (WirthySubsetOf l) 
Instance details

Defined in Language.Oberon.Abstract

Associated Types

type Module (WirthySubsetOf l) = (m :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Declaration (WirthySubsetOf l) = (d :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Type (WirthySubsetOf l) = (t :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Statement (WirthySubsetOf l) = (s :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Expression (WirthySubsetOf l) = (e :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Designator (WirthySubsetOf l) = (d :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Value (WirthySubsetOf l) = (v :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type FieldList (WirthySubsetOf l) = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type ProcedureHeading (WirthySubsetOf l) = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type FormalParameters (WirthySubsetOf l) = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type FPSection (WirthySubsetOf l) = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Block (WirthySubsetOf l) = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type StatementSequence (WirthySubsetOf l) = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Case (WirthySubsetOf l) = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type CaseLabels (WirthySubsetOf l) = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type ConditionalBranch (WirthySubsetOf l) = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Element (WirthySubsetOf l) = (x :: Type -> (Type -> Type) -> (Type -> Type) -> Type) #

type Import (WirthySubsetOf l) = (x :: Type) #

type IdentDef (WirthySubsetOf l) = (x :: Type) #

type QualIdent (WirthySubsetOf l) = (x :: Type) #

Methods

constantDeclaration :: forall l' f (f' :: Type -> Type). IdentDef l' -> f (ConstExpression l' l' f' f') -> Declaration (WirthySubsetOf l) l' f' f #

typeDeclaration :: forall l' f (f' :: Type -> Type). IdentDef l' -> f (Type l' l' f' f') -> Declaration (WirthySubsetOf l) l' f' f #

variableDeclaration :: forall l' f (f' :: Type -> Type). IdentList l' -> f (Type l' l' f' f') -> Declaration (WirthySubsetOf l) l' f' f #

procedureDeclaration :: forall f l' (f' :: Type -> Type). f (ProcedureHeading l' l' f' f') -> f (Block l' l' f' f') -> Declaration (WirthySubsetOf l) l' f' f #

formalParameters :: forall f l' (f' :: Type -> Type). [f (FPSection l' l' f' f')] -> Maybe (ReturnType l') -> FormalParameters (WirthySubsetOf l) l' f' f #

fpSection :: forall f l' (f' :: Type -> Type). Bool -> [Ident] -> f (Type l' l' f' f') -> FPSection (WirthySubsetOf l) l' f' f #

block :: forall f l' (f' :: Type -> Type). [f (Declaration l' l' f' f')] -> Maybe (f (StatementSequence l' l' f' f')) -> Block (WirthySubsetOf l) l' f' f #

fieldList :: forall l' f (f' :: Type -> Type). NonEmpty (IdentDef l') -> f (Type l' l' f' f') -> FieldList (WirthySubsetOf l) l' f' f #

pointerType :: forall f l' (f' :: Type -> Type). f (Type l' l' f' f') -> Type (WirthySubsetOf l) l' f' f #

procedureType :: forall f l' (f' :: Type -> Type). Maybe (f (FormalParameters l' l' f' f')) -> Type (WirthySubsetOf l) l' f' f #

typeReference :: forall l' (f' :: Type -> Type) (f :: Type -> Type). QualIdent l' -> Type (WirthySubsetOf l) l' f' f #

assignment :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> f (Expression l' l' f' f') -> Statement (WirthySubsetOf l) l' f' f #

caseStatement :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> [f (Case l' l' f' f')] -> Maybe (f (StatementSequence l' l' f' f')) -> Statement (WirthySubsetOf l) l' f' f #

emptyStatement :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Statement (WirthySubsetOf l) l' f' f #

exitStatement :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Statement (WirthySubsetOf l) l' f' f #

ifStatement :: forall f l' (f' :: Type -> Type). NonEmpty (f (ConditionalBranch l' l' f' f')) -> Maybe (f (StatementSequence l' l' f' f')) -> Statement (WirthySubsetOf l) l' f' f #

loopStatement :: forall f l' (f' :: Type -> Type). f (StatementSequence l' l' f' f') -> Statement (WirthySubsetOf l) l' f' f #

procedureCall :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> Maybe [f (Expression l' l' f' f')] -> Statement (WirthySubsetOf l) l' f' f #

repeatStatement :: forall f l' (f' :: Type -> Type). f (StatementSequence l' l' f' f') -> f (Expression l' l' f' f') -> Statement (WirthySubsetOf l) l' f' f #

returnStatement :: forall f l' (f' :: Type -> Type). Maybe (f (Expression l' l' f' f')) -> Statement (WirthySubsetOf l) l' f' f #

whileStatement :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (StatementSequence l' l' f' f') -> Statement (WirthySubsetOf l) l' f' f #

conditionalBranch :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (StatementSequence l' l' f' f') -> ConditionalBranch (WirthySubsetOf l) l' f' f #

caseAlternative :: forall f l' (f' :: Type -> Type). NonEmpty (f (CaseLabels l' l' f' f')) -> f (StatementSequence l' l' f' f') -> Case (WirthySubsetOf l) l' f' f #

singleLabel :: forall f l' (f' :: Type -> Type). f (ConstExpression l' l' f' f') -> CaseLabels (WirthySubsetOf l) l' f' f #

labelRange :: forall f l' (f' :: Type -> Type). f (ConstExpression l' l' f' f') -> f (ConstExpression l' l' f' f') -> CaseLabels (WirthySubsetOf l) l' f' f #

statementSequence :: forall f l' (f' :: Type -> Type). [f (Statement l' l' f' f')] -> StatementSequence (WirthySubsetOf l) l' f' f #

add :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression (WirthySubsetOf l) l' f' f #

subtract :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression (WirthySubsetOf l) l' f' f #

and :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression (WirthySubsetOf l) l' f' f #

or :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression (WirthySubsetOf l) l' f' f #

divide :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression (WirthySubsetOf l) l' f' f #

integerDivide :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression (WirthySubsetOf l) l' f' f #

modulo :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression (WirthySubsetOf l) l' f' f #

multiply :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression (WirthySubsetOf l) l' f' f #

functionCall :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> [f (Expression l' l' f' f')] -> Expression (WirthySubsetOf l) l' f' f #

literal :: forall f l' (f' :: Type -> Type). f (Value l' l' f' f') -> Expression (WirthySubsetOf l) l' f' f #

negative :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> Expression (WirthySubsetOf l) l' f' f #

positive :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> Expression (WirthySubsetOf l) l' f' f #

not :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> Expression (WirthySubsetOf l) l' f' f #

read :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> Expression (WirthySubsetOf l) l' f' f #

relation :: forall f l' (f' :: Type -> Type). RelOp -> f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Expression (WirthySubsetOf l) l' f' f #

element :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> Element (WirthySubsetOf l) l' f' f #

range :: forall f l' (f' :: Type -> Type). f (Expression l' l' f' f') -> f (Expression l' l' f' f') -> Element (WirthySubsetOf l) l' f' f #

integer :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Integer -> Value (WirthySubsetOf l) l' f' f #

nil :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Value (WirthySubsetOf l) l' f' f #

false :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Value (WirthySubsetOf l) l' f' f #

true :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Value (WirthySubsetOf l) l' f' f #

real :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Double -> Value (WirthySubsetOf l) l' f' f #

string :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Text -> Value (WirthySubsetOf l) l' f' f #

charCode :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Int -> Value (WirthySubsetOf l) l' f' f #

builtin :: forall l' (f' :: Type -> Type) (f :: Type -> Type). Text -> Value (WirthySubsetOf l) l' f' f #

variable :: forall l' (f' :: Type -> Type) (f :: Type -> Type). QualIdent l' -> Designator (WirthySubsetOf l) l' f' f #

field :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> Ident -> Designator (WirthySubsetOf l) l' f' f #

index :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> NonEmpty (f (Expression l' l' f' f')) -> Designator (WirthySubsetOf l) l' f' f #

dereference :: forall f l' (f' :: Type -> Type). f (Designator l' l' f' f') -> Designator (WirthySubsetOf l) l' f' f #

identDef :: Ident -> IdentDef (WirthySubsetOf l) #

nonQualIdent :: Ident -> QualIdent (WirthySubsetOf l) #

type Definition (WirthySubsetOf l) Source # 
Instance details

Defined in Language.Modula2.Abstract

type Export (WirthySubsetOf l) Source # 
Instance details

Defined in Language.Modula2.Abstract

type Variant (WirthySubsetOf l) Source # 
Instance details

Defined in Language.Modula2.Abstract

type AddressedIdent (WirthySubsetOf l) Source # 
Instance details

Defined in Language.Modula2.ISO.Abstract

type Item (WirthySubsetOf l) Source # 
Instance details

Defined in Language.Modula2.ISO.Abstract

type Block (WirthySubsetOf l) 
Instance details

Defined in Language.Oberon.Abstract

type Case (WirthySubsetOf l) 
Instance details

Defined in Language.Oberon.Abstract

type CaseLabels (WirthySubsetOf l) 
Instance details

Defined in Language.Oberon.Abstract

type ConditionalBranch (WirthySubsetOf l) 
Instance details

Defined in Language.Oberon.Abstract

type Declaration (WirthySubsetOf l) 
Instance details

Defined in Language.Oberon.Abstract

type Designator (WirthySubsetOf l) 
Instance details

Defined in Language.Oberon.Abstract

type Element (WirthySubsetOf l) 
Instance details

Defined in Language.Oberon.Abstract

type Expression (WirthySubsetOf l) 
Instance details

Defined in Language.Oberon.Abstract

type FPSection (WirthySubsetOf l) 
Instance details

Defined in Language.Oberon.Abstract

type FieldList (WirthySubsetOf l) 
Instance details

Defined in Language.Oberon.Abstract

type FormalParameters (WirthySubsetOf l) 
Instance details

Defined in Language.Oberon.Abstract

type IdentDef (WirthySubsetOf l) 
Instance details

Defined in Language.Oberon.Abstract

type Import (WirthySubsetOf l) 
Instance details

Defined in Language.Oberon.Abstract

type Module (WirthySubsetOf l) 
Instance details

Defined in Language.Oberon.Abstract

type ProcedureHeading (WirthySubsetOf l) 
Instance details

Defined in Language.Oberon.Abstract

type QualIdent (WirthySubsetOf l) 
Instance details

Defined in Language.Oberon.Abstract

type Statement (WirthySubsetOf l) 
Instance details

Defined in Language.Oberon.Abstract

type StatementSequence (WirthySubsetOf l) 
Instance details

Defined in Language.Oberon.Abstract

type Type (WirthySubsetOf l) 
Instance details

Defined in Language.Oberon.Abstract

type Value (WirthySubsetOf l) 
Instance details

Defined in Language.Oberon.Abstract

type WithAlternative (WirthySubsetOf l) 
Instance details

Defined in Language.Oberon.Abstract

newtype Maybe3 (f :: k -> k1 -> k2 -> Type) (a :: k) (b :: k1) (c :: k2) #

A modified Maybe with kind that fits the types associated with Wirthy.

Constructors

Maybe3 (Maybe (f a b c)) 

Instances

Instances details
Read (f a b c) => Read (Maybe3 f a b c) 
Instance details

Defined in Language.Oberon.Abstract

Methods

readsPrec :: Int -> ReadS (Maybe3 f a b c) #

readList :: ReadS [Maybe3 f a b c] #

readPrec :: ReadPrec (Maybe3 f a b c) #

readListPrec :: ReadPrec [Maybe3 f a b c] #

Show (f a b c) => Show (Maybe3 f a b c) 
Instance details

Defined in Language.Oberon.Abstract

Methods

showsPrec :: Int -> Maybe3 f a b c -> ShowS #

show :: Maybe3 f a b c -> String #

showList :: [Maybe3 f a b c] -> ShowS #

Eq (f a b c) => Eq (Maybe3 f a b c) 
Instance details

Defined in Language.Oberon.Abstract

Methods

(==) :: Maybe3 f a b c -> Maybe3 f a b c -> Bool #

(/=) :: Maybe3 f a b c -> Maybe3 f a b c -> Bool #

Ord (f a b c) => Ord (Maybe3 f a b c) 
Instance details

Defined in Language.Oberon.Abstract

Methods

compare :: Maybe3 f a b c -> Maybe3 f a b c -> Ordering #

(<) :: Maybe3 f a b c -> Maybe3 f a b c -> Bool #

(<=) :: Maybe3 f a b c -> Maybe3 f a b c -> Bool #

(>) :: Maybe3 f a b c -> Maybe3 f a b c -> Bool #

(>=) :: Maybe3 f a b c -> Maybe3 f a b c -> Bool #

max :: Maybe3 f a b c -> Maybe3 f a b c -> Maybe3 f a b c #

min :: Maybe3 f a b c -> Maybe3 f a b c -> Maybe3 f a b c #

just3 :: forall {k1} {k2} {k3} {f} {a :: k1} {b :: k2} {c :: k3}. f a b c -> Maybe3 f a b c #

Smart Maybe3 constructor corresponding to Just

maybe3 :: forall {k1} {k2} {k3} {b1} {f} {a :: k1} {b2 :: k2} {c :: k3}. b1 -> (f a b2 c -> b1) -> Maybe3 f a b2 c -> b1 #

Smart Maybe3 destructor corresponding to maybe

nothing3 :: forall {k1} {k2} {k3} {f :: k1 -> k2 -> k3 -> Type} {a :: k1} {b :: k2} {c :: k3}. Maybe3 f a b c #

Smart Maybe3 constructor corresponding to Nothing