drasil-gool-0.1.1.0: A framework for code and document generation for scientific software - GOOL SubPackage
Safe HaskellSafe-Inferred
LanguageHaskell2010

Drasil.GOOL

Description

re-export smart constructors for external code writing

Synopsis

Documentation

type GSProgram a = GS (a (Program a)) Source #

type SFile a = FS (a (File a)) Source #

type MSBody a = MS (a (Body a)) Source #

type MSBlock a = MS (a (Block a)) Source #

type VSType a = VS (a (Type a)) Source #

type SVariable a = VS (a (Variable a)) Source #

type SValue a = VS (a (Value a)) Source #

type VSFunction a = VS (a (Function a)) Source #

type MSStatement a = MS (a (Statement a)) Source #

type MSParameter a = MS (a (Parameter a)) Source #

type SMethod a = MS (a (Method a)) Source #

type CSStateVar a = CS (a (StateVar a)) Source #

type SClass a = CS (a (Class a)) Source #

type FSModule a = FS (a (Module a)) Source #

type NamedArgs r = [(SVariable r, SValue r)] Source #

class FileSym r => ProgramSym r where Source #

Associated Types

type Program r Source #

Methods

prog :: Label -> Label -> [SFile r] -> GSProgram r Source #

class ModuleSym r => FileSym r where Source #

Associated Types

type File r Source #

Methods

fileDoc :: FSModule r -> SFile r Source #

docMod :: String -> [String] -> String -> SFile r -> SFile r Source #

class PermanenceSym r where Source #

Associated Types

type Permanence r Source #

class BlockSym r => BodySym r where Source #

Associated Types

type Body r Source #

Methods

body :: [MSBlock r] -> MSBody r Source #

addComments :: Label -> MSBody r -> MSBody r Source #

class StatementSym r => BlockSym r where Source #

Associated Types

type Block r Source #

Methods

block :: [MSStatement r] -> MSBlock r Source #

class TypeSym r => OOTypeSym r where Source #

Methods

obj :: ClassName -> VSType r Source #

class TypeSym r => TypeElim r where Source #

Methods

getType :: r (Type r) -> CodeType Source #

getTypeString :: r (Type r) -> String Source #

class ThunkSym r Source #

Associated Types

type Thunk (r :: Type -> Type) Source #

class TypeSym r => VectorType r where Source #

Methods

vecType :: VSType r -> VSType r Source #

class DeclStatement r => VectorDecl r where Source #

Methods

vecDec :: Integer -> SVariable r -> r (Scope r) -> MSStatement r Source #

vecDecDef :: SVariable r -> r (Scope r) -> [SValue r] -> MSStatement r Source #

class (VariableSym r, ThunkSym r) => VectorThunk r where Source #

Methods

vecThunk :: SVariable r -> VSThunk r Source #

class (ThunkSym r, ValueSym r) => VectorExpression r where Source #

Methods

vecScale :: SValue r -> VSThunk r -> VSThunk r Source #

vecAdd :: VSThunk r -> VSThunk r -> VSThunk r Source #

vecIndex :: SValue r -> VSThunk r -> SValue r Source #

vecDot :: VSThunk r -> VSThunk r -> VSThunk r Source #

class (VariableSym r, ThunkSym r, StatementSym r) => ThunkAssign r where Source #

Methods

thunkAssign :: SVariable r -> VSThunk r -> MSStatement r Source #

class ValueSym r => StatementSym r where Source #

Associated Types

type Statement r Source #

class (VariableSym r, StatementSym r) => AssignStatement r where Source #

Methods

(&-=) :: SVariable r -> SValue r -> MSStatement r infixl 1 Source #

(&+=) :: SVariable r -> SValue r -> MSStatement r infixl 1 Source #

(&++) :: SVariable r -> MSStatement r infixl 8 Source #

(&--) :: SVariable r -> MSStatement r infixl 8 Source #

assign :: SVariable r -> SValue r -> MSStatement r Source #

(&=) :: AssignStatement r => SVariable r -> SValue r -> MSStatement r infixr 1 Source #

class (DeclStatement r, OOVariableSym r) => OODeclStatement r where Source #

Methods

objDecDef :: SVariable r -> r (Scope r) -> SValue r -> MSStatement r Source #

objDecNew :: SVariable r -> r (Scope r) -> [SValue r] -> MSStatement r Source #

extObjDecNew :: Library -> SVariable r -> r (Scope r) -> [SValue r] -> MSStatement r Source #

class (VariableSym r, StatementSym r) => FuncAppStatement r where Source #

Methods

inOutCall :: InOutCall r Source #

extInOutCall :: Library -> InOutCall r Source #

class (FuncAppStatement r, OOVariableSym r) => OOFuncAppStatement r where Source #

Methods

selfInOutCall :: InOutCall r Source #

class (BodySym r, VariableSym r) => ControlStatement r where Source #

Methods

break :: MSStatement r Source #

continue :: MSStatement r Source #

returnStmt :: SValue r -> MSStatement r Source #

throw :: Label -> MSStatement r Source #

ifCond :: [(SValue r, MSBody r)] -> MSBody r -> MSStatement r Source #

String of if-else statements. Arguments: List of predicates and bodies (if this then that), Body for else branch

switch :: SValue r -> [(SValue r, MSBody r)] -> MSBody r -> MSStatement r Source #

ifExists :: SValue r -> MSBody r -> MSBody r -> MSStatement r Source #

for :: MSStatement r -> SValue r -> MSStatement r -> MSBody r -> MSStatement r Source #

forRange :: SVariable r -> SValue r -> SValue r -> SValue r -> MSBody r -> MSStatement r Source #

forEach :: SVariable r -> SValue r -> MSBody r -> MSStatement r Source #

while :: SValue r -> MSBody r -> MSStatement r Source #

tryCatch :: MSBody r -> MSBody r -> MSStatement r Source #

assert :: SValue r -> SValue r -> MSStatement r Source #

class TypeSym r => VariableSym r where Source #

Associated Types

type Variable r Source #

class ScopeSym r where Source #

Associated Types

type Scope r Source #

Methods

global :: r (Scope r) Source #

mainFn :: r (Scope r) Source #

local :: r (Scope r) Source #

class VariableSym r => VariableElim r where Source #

Methods

variableName :: r (Variable r) -> String Source #

variableType :: r (Variable r) -> r (Type r) Source #

($->) :: OOVariableSym r => SVariable r -> SVariable r -> SVariable r infixl 9 Source #

class TypeSym r => ValueSym r where Source #

Associated Types

type Value r Source #

Methods

valueType :: r (Value r) -> r (Type r) Source #

class ValueSym r => Argument r where Source #

Methods

pointerArg :: SValue r -> SValue r Source #

class ValueSym r => MathConstant r where Source #

Methods

pi :: SValue r Source #

class (VariableSym r, ValueSym r) => VariableValue r where Source #

Methods

valueOf :: SVariable r -> SValue r Source #

class ValueSym r => NumericExpression r where Source #

Methods

(#~) :: SValue r -> SValue r infixl 8 Source #

(#/^) :: SValue r -> SValue r infixl 7 Source #

(#|) :: SValue r -> SValue r infixl 7 Source #

(#+) :: SValue r -> SValue r -> SValue r infixl 5 Source #

(#-) :: SValue r -> SValue r -> SValue r infixl 5 Source #

(#*) :: SValue r -> SValue r -> SValue r infixl 6 Source #

(#/) :: SValue r -> SValue r -> SValue r infixl 6 Source #

(#%) :: SValue r -> SValue r -> SValue r infixl 6 Source #

(#^) :: SValue r -> SValue r -> SValue r infixl 7 Source #

log :: SValue r -> SValue r Source #

ln :: SValue r -> SValue r Source #

exp :: SValue r -> SValue r Source #

sin :: SValue r -> SValue r Source #

cos :: SValue r -> SValue r Source #

tan :: SValue r -> SValue r Source #

csc :: SValue r -> SValue r Source #

sec :: SValue r -> SValue r Source #

cot :: SValue r -> SValue r Source #

arcsin :: SValue r -> SValue r Source #

arccos :: SValue r -> SValue r Source #

arctan :: SValue r -> SValue r Source #

floor :: SValue r -> SValue r Source #

ceil :: SValue r -> SValue r Source #

class ValueSym r => BooleanExpression r where Source #

Methods

(?!) :: SValue r -> SValue r infixr 6 Source #

(?&&) :: SValue r -> SValue r -> SValue r infixl 2 Source #

(?||) :: SValue r -> SValue r -> SValue r infixl 1 Source #

class ValueSym r => Comparison r where Source #

Methods

(?<) :: SValue r -> SValue r -> SValue r infixl 4 Source #

(?<=) :: SValue r -> SValue r -> SValue r infixl 4 Source #

(?>) :: SValue r -> SValue r -> SValue r infixl 4 Source #

(?>=) :: SValue r -> SValue r -> SValue r infixl 4 Source #

(?==) :: SValue r -> SValue r -> SValue r infixl 3 Source #

(?!=) :: SValue r -> SValue r -> SValue r infixl 3 Source #

class (VariableSym r, ValueSym r) => ValueExpression r where Source #

Methods

inlineIf :: SValue r -> SValue r -> SValue r -> SValue r Source #

funcAppMixedArgs :: MixedCall r Source #

extFuncAppMixedArgs :: Library -> MixedCall r Source #

libFuncAppMixedArgs :: Library -> MixedCall r Source #

lambda :: [SVariable r] -> SValue r -> SValue r Source #

notNull :: SValue r -> SValue r Source #

class (ValueExpression r, OOVariableSym r, OOValueSym r) => OOValueExpression r where Source #

Methods

selfFuncAppMixedArgs :: MixedCall r Source #

newObjMixedArgs :: MixedCtorCall r Source #

extNewObjMixedArgs :: Library -> MixedCtorCall r Source #

libNewObjMixedArgs :: Library -> MixedCtorCall r Source #

funcApp :: ValueExpression r => PosCall r Source #

extFuncApp :: ValueExpression r => Library -> PosCall r Source #

libFuncApp :: ValueExpression r => Library -> PosCall r Source #

newObj :: OOValueExpression r => PosCtorCall r Source #

extNewObj :: OOValueExpression r => Library -> PosCtorCall r Source #

libNewObj :: OOValueExpression r => Library -> PosCtorCall r Source #

objMethodCall :: InternalValueExp r => VSType r -> SValue r -> Label -> [SValue r] -> SValue r Source #

Calling a method. t is the return type of the method, o is the object, f is the method name, and ps is a list of positional arguments.

objMethodCallNamedArgs :: InternalValueExp r => VSType r -> SValue r -> Label -> NamedArgs r -> SValue r Source #

Calling a method with named arguments.

objMethodCallMixedArgs :: InternalValueExp r => VSType r -> SValue r -> Label -> [SValue r] -> NamedArgs r -> SValue r Source #

Calling a method with a mix of positional and named arguments.

objMethodCallNoParams :: InternalValueExp r => VSType r -> SValue r -> Label -> SValue r Source #

Calling a method with no parameters.

class ValueSym r => FunctionSym r Source #

Associated Types

type Function r Source #

class FunctionSym r => OOFunctionSym r where Source #

Methods

func :: Label -> VSType r -> [SValue r] -> VSFunction r Source #

objAccess :: SValue r -> VSFunction r -> SValue r Source #

($.) :: OOFunctionSym r => SValue r -> VSFunction r -> SValue r infixl 9 Source #

class (ValueSym r, VariableSym r) => GetSet r where Source #

Methods

get :: SValue r -> SVariable r -> SValue r Source #

set :: SValue r -> SVariable r -> SValue r -> SValue r Source #

class ValueSym r => List r where Source #

Methods

intToIndex :: SValue r -> SValue r Source #

Does any necessary conversions from GOOL's zero-indexed assumptions to the target language's assumptions

indexToInt :: SValue r -> SValue r Source #

Does any necessary conversions from the target language's indexing assumptions assumptions to GOOL's zero-indexed assumptions

listSize :: SValue r -> SValue r Source #

Finds the size of a list. Arguments are: List

listAdd :: SValue r -> SValue r -> SValue r -> SValue r Source #

Inserts a value into a list. Arguments are: List, Index, Value

listAppend :: SValue r -> SValue r -> SValue r Source #

Appens a value to a list. Arguments are: List, Value

listAccess :: SValue r -> SValue r -> SValue r Source #

Gets the value of an index of a list. Arguments are: List, Index

listSet :: SValue r -> SValue r -> SValue r -> SValue r Source #

Sets the value of an index of a list. Arguments are: List, Index, Value

indexOf :: SValue r -> SValue r -> SValue r Source #

Finds the index of the first occurrence of a value in a list. Arguments are: List, Value

class ValueSym r => Set r where Source #

Methods

contains :: SValue r -> SValue r -> SValue r Source #

Checks membership Arguments are: Set, Value

setAdd :: SValue r -> SValue r -> SValue r Source #

Inserts a value into a set Arguments are: Set, Value

setRemove :: SValue r -> SValue r -> SValue r Source #

Removes a value from a set Arguments are: Set, Value

setUnion :: SValue r -> SValue r -> SValue r Source #

Removes a value from a set Arguments are: Set, Set

listSlice :: InternalList r => SVariable r -> SValue r -> Maybe (SValue r) -> Maybe (SValue r) -> Maybe (SValue r) -> MSBlock r Source #

Creates a slice of a list and assigns it to a variable. Arguments are: Variable to assign List to read from (optional) Start index inclusive. (if Nothing, then list start if step > 0, list end if step < 0) (optional) End index exclusive. (if Nothing, then list end if step > 0, list start if step > 0) (optional) Step (if Nothing, then defaults to 1)

at :: List r => SValue r -> SValue r -> SValue r Source #

class (BodySym r, VariableSym r) => StrategyPattern r where Source #

Methods

runStrategy :: Label -> [(Label, MSBody r)] -> Maybe (SValue r) -> Maybe (SVariable r) -> MSBlock r Source #

class VisibilitySym r where Source #

Associated Types

type Visibility r Source #

class VariableSym r => ParameterSym r where Source #

Associated Types

type Parameter r Source #

class (BodySym r, ParameterSym r, VisibilitySym r) => MethodSym r where Source #

Associated Types

type Method r Source #

Methods

docMain :: MSBody r -> SMethod r Source #

function :: Label -> r (Visibility r) -> VSType r -> [MSParameter r] -> MSBody r -> SMethod r Source #

mainFunction :: MSBody r -> SMethod r Source #

docFunc :: String -> [String] -> Maybe String -> SMethod r -> SMethod r Source #

inOutFunc :: Label -> r (Visibility r) -> InOutFunc r Source #

docInOutFunc :: Label -> r (Visibility r) -> DocInOutFunc r Source #

class (MethodSym r, PermanenceSym r) => OOMethodSym r where Source #

Methods

method :: Label -> r (Visibility r) -> r (Permanence r) -> VSType r -> [MSParameter r] -> MSBody r -> SMethod r Source #

getMethod :: SVariable r -> SMethod r Source #

setMethod :: SVariable r -> SMethod r Source #

constructor :: [MSParameter r] -> Initializers r -> MSBody r -> SMethod r Source #

inOutMethod :: Label -> r (Visibility r) -> r (Permanence r) -> InOutFunc r Source #

docInOutMethod :: Label -> r (Visibility r) -> r (Permanence r) -> DocInOutFunc r Source #

class (VisibilitySym r, PermanenceSym r, VariableSym r) => StateVarSym r where Source #

Associated Types

type StateVar r Source #

class (OOMethodSym r, StateVarSym r) => ClassSym r where Source #

Associated Types

type Class r Source #

Methods

buildClass :: Maybe Label -> [CSStateVar r] -> [SMethod r] -> [SMethod r] -> SClass r Source #

Main external method for creating a class. Inputs: parent class, variables, constructor(s), methods

extraClass :: Label -> Maybe Label -> [CSStateVar r] -> [SMethod r] -> [SMethod r] -> SClass r Source #

Creates an extra class. Inputs: class name, the rest are the same as buildClass.

implementingClass :: Label -> [Label] -> [CSStateVar r] -> [SMethod r] -> [SMethod r] -> SClass r Source #

Creates a class implementing interfaces. Inputs: class name, interface names, variables, constructor(s), methods

docClass :: String -> SClass r -> SClass r Source #

class ClassSym r => ModuleSym r where Source #

Associated Types

type Module r Source #

Methods

buildModule :: Label -> [Label] -> [SMethod r] -> [SClass r] -> FSModule r Source #

data VisibilityTag Source #

Constructors

Pub 
Priv 

Instances

Instances details
Eq VisibilityTag Source # 
Instance details

Defined in Drasil.GOOL.AST

data CodeType Source #

Instances

Instances details
Show CodeType Source # 
Instance details

Defined in Drasil.GOOL.CodeType

Eq CodeType Source # 
Instance details

Defined in Drasil.GOOL.CodeType

data GOOLState Source #

Constructors

GS 

Fields

lensMStoVS :: Lens' MethodState ValueState Source #

onStateValue :: (a -> b) -> State s a -> State s b Source #

onCodeList :: Monad m => ([a] -> b) -> [m a] -> m b Source #

unCI :: CodeInfoOO a -> a Source #

unPC :: PythonCode a -> a Source #

unJC :: JavaCode a -> a Source #

unCSC :: CSharpCode a -> a Source #

unCPPC :: CppCode CppSrcCode CppHdrCode a -> a Source #

unSC :: SwiftCode a -> a Source #