feldspar-compiler-0.2: Feldspar/Compiler/PluginArchitecture.hs
{-# LANGUAGE TypeFamilies, FlexibleContexts, Rank2Types #-}
module Feldspar.Compiler.PluginArchitecture (
module Feldspar.Compiler.PluginArchitecture,
module Feldspar.Compiler.Imperative.Representation,
module Feldspar.Compiler.Imperative.Semantics,
module Feldspar.Compiler.PluginArchitecture.DefaultConvert
) where
import Feldspar.Compiler.Imperative.Representation
import Feldspar.Compiler.Imperative.Semantics
import Feldspar.Compiler.PluginArchitecture.DefaultConvert
-- ==================================================================================================================================
-- == Plugin class
-- ==================================================================================================================================
type Walker t construction = (TransformationPhase t) => t -> Downwards t -> construction (From t) -> (construction (To t), Upwards t)
class (TransformationPhase t) => Plugin t where
type ExternalInfo t
executePlugin :: t -> ExternalInfo t -> Procedure (From t) -> Procedure (To t)
class (SemanticInfo (From t), SemanticInfo (To t)
, ConvertAllInfos (From t) (To t)
, Combine (Upwards t), Default (Upwards t)) => TransformationPhase t where
type From t
type To t
type Downwards t
type Upwards t
executeTransformationPhase :: Walker t Procedure
executeTransformationPhase = walkProcedure
-- ==================================================================================================================================
-- == Node Transformers specification
-- ==================================================================================================================================
downwardsProcedure :: t -> Downwards t -> Procedure (From t) -> Downwards t
transformProcedure :: t -> Downwards t -> Procedure (From t) -> InfosFromProcedureParts t -> Procedure (To t)
upwardsProcedure :: t -> Downwards t -> Procedure (From t) -> InfosFromProcedureParts t -> Procedure (To t) -> Upwards t
downwardsBlock :: t -> Downwards t -> Block (From t) -> Downwards t
transformBlock :: t -> Downwards t -> Block (From t) -> InfosFromBlockParts t -> Block (To t)
upwardsBlock :: t -> Downwards t -> Block (From t) -> InfosFromBlockParts t -> Block (To t) -> Upwards t
downwardsProgram :: t -> Downwards t -> Program (From t) -> Downwards t
transformProgram :: t -> Downwards t -> Program (From t) -> InfosFromProgramParts t -> Program (To t)
upwardsProgram :: t -> Downwards t -> Program (From t) -> InfosFromProgramParts t -> Program (To t) -> Upwards t
transformEmpty :: t -> Downwards t -> Empty (From t) -> ProgramConstruction (To t)
upwardsEmpty :: t -> Downwards t -> Empty (From t) -> ProgramConstruction (To t) -> Upwards t
downwardsPrimitive :: t -> Downwards t -> Primitive (From t) -> Downwards t
transformPrimitive :: t -> Downwards t -> Primitive (From t) -> InfosFromPrimitiveParts t -> ProgramConstruction (To t)
upwardsPrimitive :: t -> Downwards t -> Primitive (From t) -> InfosFromPrimitiveParts t -> ProgramConstruction (To t) -> Upwards t
downwardsSequence :: t -> Downwards t -> Sequence (From t) -> Downwards t
transformSequence :: t -> Downwards t -> Sequence (From t) -> InfosFromSequenceParts t -> ProgramConstruction (To t)
upwardsSequence :: t -> Downwards t -> Sequence (From t) -> InfosFromSequenceParts t -> ProgramConstruction (To t) -> Upwards t
downwardsBranch :: t -> Downwards t -> Branch (From t) -> Downwards t
transformBranch :: t -> Downwards t -> Branch (From t) -> InfosFromBranchParts t -> ProgramConstruction (To t)
upwardsBranch :: t -> Downwards t -> Branch (From t) -> InfosFromBranchParts t -> ProgramConstruction (To t) -> Upwards t
downwardsSequentialLoop :: t -> Downwards t -> SequentialLoop (From t) -> Downwards t
transformSequentialLoop :: t -> Downwards t -> SequentialLoop (From t) -> InfosFromSequentialLoopParts t -> ProgramConstruction (To t)
upwardsSequentialLoop :: t -> Downwards t -> SequentialLoop (From t) -> InfosFromSequentialLoopParts t -> ProgramConstruction (To t) -> Upwards t
downwardsParallelLoop :: t -> Downwards t -> ParallelLoop (From t) -> Downwards t
transformParallelLoop :: t -> Downwards t -> ParallelLoop (From t) -> InfosFromParallelLoopParts t -> ProgramConstruction (To t)
upwardsParallelLoop :: t -> Downwards t -> ParallelLoop (From t) -> InfosFromParallelLoopParts t -> ProgramConstruction (To t) -> Upwards t
downwardsFormalParameter :: t -> Downwards t -> FormalParameter (From t) -> Downwards t
transformFormalParameter :: t -> Downwards t -> FormalParameter (From t) -> InfosFromFormalParameterParts t -> FormalParameter (To t)
upwardsFormalParameter :: t -> Downwards t -> FormalParameter (From t) -> InfosFromFormalParameterParts t -> FormalParameter (To t) -> Upwards t
downwardsLocalDeclaration :: t -> Downwards t -> LocalDeclaration (From t) -> Downwards t
transformLocalDeclaration :: t -> Downwards t -> LocalDeclaration (From t) -> InfosFromLocalDeclarationParts t -> LocalDeclaration (To t)
upwardsLocalDeclaration :: t -> Downwards t -> LocalDeclaration (From t) -> InfosFromLocalDeclarationParts t -> LocalDeclaration (To t) -> Upwards t
downwardsAssignment :: t -> Downwards t -> Assignment (From t) -> Downwards t
transformAssignment :: t -> Downwards t -> Assignment (From t) -> InfosFromAssignmentParts t -> Instruction (To t)
upwardsAssignment :: t -> Downwards t -> Assignment (From t) -> InfosFromAssignmentParts t -> Instruction (To t) -> Upwards t
downwardsProcedureCall :: t -> Downwards t -> ProcedureCall (From t) -> Downwards t
transformProcedureCall :: t -> Downwards t -> ProcedureCall (From t) -> InfosFromProcedureCallParts t -> Instruction (To t)
upwardsProcedureCall :: t -> Downwards t -> ProcedureCall (From t) -> InfosFromProcedureCallParts t -> Instruction (To t) -> Upwards t
downwardsInputActualParameter :: t -> Downwards t -> InputActualParameterType (From t) -> Downwards t
transformInputActualParameter :: t -> Downwards t -> InputActualParameterType (From t) -> InfosFromInputActualParameterParts t -> ActualParameter (To t)
upwardsInputActualParameter :: t -> Downwards t -> InputActualParameterType (From t) -> InfosFromInputActualParameterParts t -> ActualParameter (To t) -> Upwards t
downwardsOutputActualParameter :: t -> Downwards t -> OutputActualParameterType (From t) -> Downwards t
transformOutputActualParameter :: t -> Downwards t -> OutputActualParameterType (From t) -> InfosFromOutputActualParameterParts t -> ActualParameter (To t)
upwardsOutputActualParameter :: t -> Downwards t -> OutputActualParameterType (From t) -> InfosFromOutputActualParameterParts t -> ActualParameter (To t) -> Upwards t
downwardsVariableInLeftValue :: t -> Downwards t -> VariableInLeftValue (From t) -> Downwards t
transformVariableInLeftValue :: t -> Downwards t -> VariableInLeftValue (From t) -> InfosFromVariableLeftValueParts t -> LeftValue (To t)
upwardsVariableInLeftValue :: t -> Downwards t -> VariableInLeftValue (From t) -> InfosFromVariableLeftValueParts t -> LeftValue (To t) -> Upwards t
downwardsArrayElemReference :: t -> Downwards t -> ArrayElemReference (From t) -> Downwards t
transformArrayElemReference :: t -> Downwards t -> ArrayElemReference (From t) -> InfosFromArrayElemReferenceParts t -> LeftValue (To t)
upwardsArrayElemReference :: t -> Downwards t -> ArrayElemReference (From t) -> InfosFromArrayElemReferenceParts t -> LeftValue (To t) -> Upwards t
downwardsLeftValueExpression :: t -> Downwards t -> LeftValueInExpression (From t) -> Downwards t
transformLeftValueExpression :: t -> Downwards t -> LeftValueInExpression (From t) -> InfosFromLeftValueExpressionParts t -> Expression (To t)
upwardsLeftValueExpression :: t -> Downwards t -> LeftValueInExpression (From t) -> InfosFromLeftValueExpressionParts t -> Expression (To t) -> Upwards t
downwardsFunctionCall :: t -> Downwards t -> FunctionCall (From t) -> Downwards t
transformFunctionCall :: t -> Downwards t -> FunctionCall (From t) -> InfosFromFunctionCallParts t -> Expression (To t)
upwardsFunctionCall :: t -> Downwards t -> FunctionCall (From t) -> InfosFromFunctionCallParts t -> Expression (To t) -> Upwards t
transformIntConstant :: t -> Downwards t -> IntConstantType (From t) -> Constant (To t)
upwardsIntConstant :: t -> Downwards t -> IntConstantType (From t) -> Constant (To t) -> Upwards t
transformFloatConstant :: t -> Downwards t -> FloatConstantType (From t) -> Constant (To t)
upwardsFloatConstant :: t -> Downwards t -> FloatConstantType (From t) -> Constant (To t) -> Upwards t
transformBoolConstant :: t -> Downwards t -> BoolConstantType (From t) -> Constant (To t)
upwardsBoolConstant :: t -> Downwards t -> BoolConstantType (From t) -> Constant (To t) -> Upwards t
downwardsArrayConstant :: t -> Downwards t -> ArrayConstantType (From t) -> Downwards t
transformArrayConstant :: t -> Downwards t -> ArrayConstantType (From t) -> InfosFromArrayConstantParts t -> Constant (To t)
upwardsArrayConstant :: t -> Downwards t -> ArrayConstantType (From t) -> InfosFromArrayConstantParts t -> Constant (To t) -> Upwards t
transformVariable :: t -> Downwards t -> Variable (From t) -> Variable (To t)
upwardsVariable :: t -> Downwards t -> Variable (From t) -> Variable (To t) -> Upwards t
-- ==================================================================================================================================
-- == Node Transformer defaults
-- ==================================================================================================================================
downwardsProcedure self = const
transformProcedure self fromAbove originalProcedure fromBelow = originalProcedure {
inParameters = recursivelyTransformedInParameters fromBelow,
outParameters = recursivelyTransformedOutParameters fromBelow,
procedureBody = recursivelyTransformedProcedureBody fromBelow,
procedureSemInf = convert $ procedureSemInf originalProcedure
}
upwardsProcedure self fromAbove originalProcedure fromBelow transformedProcedure = foldl combine (upwardsInfoFromProcedureBody fromBelow)
((upwardsInfoFromInParameters fromBelow)++(upwardsInfoFromOutParameters fromBelow))
downwardsBlock self = const
transformBlock self fromAbove originalBlock fromBelow = Block {
blockData = recursivelyTransformedBlockData fromBelow,
blockSemInf = convert $ blockSemInf originalBlock
}
upwardsBlock self fromAbove originalBlock fromBelow transformedBlock = foldl combine
(upwardsInfoFromBlockInstructions fromBelow) (upwardsInfoFromBlockDeclarations fromBelow)
downwardsProgram self = const
transformProgram self fromAbove originalProgram fromBelow = Program {
programConstruction = recursivelyTransformedProgramConstruction fromBelow,
programSemInf = convert $ programSemInf originalProgram
}
upwardsProgram self fromAbove originalProgram fromBelow transformedProgram = upwardsInfoFromProgramConstruction fromBelow
transformEmpty self fromAbove originalEmpty = EmptyProgram $ Empty {
emptySemInf = convert $ emptySemInf originalEmpty
}
upwardsEmpty self fromAbove originalEmpty transformedEmpty = defaultValue
downwardsPrimitive self = const
transformPrimitive self fromAbove originalPrimitive fromBelow = PrimitiveProgram $ Primitive {
primitiveInstruction = recursivelyTransformedPrimitiveInstruction fromBelow,
primitiveSemInf = convert $ primitiveSemInf originalPrimitive
}
upwardsPrimitive self fromAbove originalPrimitive fromBelow transformedPrimitive = upwardsInfoFromPrimitiveInstruction fromBelow
downwardsSequence self = const
transformSequence self fromAbove originalSequence fromBelow = SequenceProgram $ Sequence {
sequenceProgramList = recursivelyTransformedSequenceProgramList fromBelow,
sequenceSemInf = convert $ sequenceSemInf originalSequence
}
upwardsSequence self fromAbove originalSequence fromBelow transformedSequence = case ul of
[] -> defaultValue
otherwise -> foldl combine (head ul) (tail ul)
where ul = upwardsInfoFromSequenceProgramList fromBelow
downwardsBranch self = const
transformBranch self fromAbove originalBranch fromBelow = BranchProgram $ Branch {
branchData = recursivelyTransformedBranchData fromBelow,
branchSemInf = convert $ branchSemInf originalBranch
}
upwardsBranch self fromAbove originalBranch fromBelow transformedBranch =
foldl combine (upwardsInfoFromBranchConditionVariable fromBelow) [upwardsInfoFromThenBlock fromBelow, upwardsInfoFromElseBlock fromBelow]
downwardsSequentialLoop self = const
transformSequentialLoop self fromAbove originalSequentialLoop fromBelow = SequentialLoopProgram $ SequentialLoop {
sequentialLoopData = recursivelyTransformedSequentialLoopData fromBelow,
sequentialLoopSemInf = convert $ sequentialLoopSemInf originalSequentialLoop
}
upwardsSequentialLoop self fromAbove originalSequentialLoop fromBelow transformedSequentialLoop =
foldl combine (upwardsInfoFromSequentialLoopConditionVariable fromBelow)
[upwardsInfoFromSequentialLoopConditionCalculation fromBelow, upwardsInfoFromSequentialLoopCore fromBelow]
downwardsParallelLoop self = const
transformParallelLoop self fromAbove originalParallelLoop fromBelow = ParallelLoopProgram $ ParallelLoop {
parallelLoopData = recursivelyTransformedParallelLoopData fromBelow,
parallelLoopSemInf = convert $ parallelLoopSemInf originalParallelLoop
}
upwardsParallelLoop self fromAbove originalParallelLoop fromBelow transformedParallelLoop =
foldl combine (upwardsInfoFromParallelLoopConditionVariable fromBelow)
[upwardsInfoFromNumberOfIterations fromBelow, upwardsInfoFromParallelLoopCore fromBelow]
downwardsFormalParameter self = const
transformFormalParameter self fromAbove originalFormalParameter fromBelow = FormalParameter {
formalParameterVariable = recursivelyTransformedFormalParameterVariable fromBelow,
formalParameterSemInf = convert $ formalParameterSemInf originalFormalParameter
}
upwardsFormalParameter self fromAbove originalFormalParameter fromBelow transformedFormalParameter =
upwardsInfoFromFormalParameterVariable fromBelow
downwardsLocalDeclaration self = const
transformLocalDeclaration self fromAbove originalLocalDeclaration fromBelow = LocalDeclaration {
localDeclarationData = recursivelyTransformedLocalDeclarationData fromBelow,
localDeclarationSemInf = convert $ localDeclarationSemInf originalLocalDeclaration
}
upwardsLocalDeclaration self fromAbove originalLocalDeclaration fromBelow transformedLocalDeclaration =
case (upwardsInfoFromLocalInitValue fromBelow) of
Nothing -> (upwardsInfoFromLocalVariable fromBelow)
Just justUpFromLocalInitValue -> combine (upwardsInfoFromLocalVariable fromBelow) justUpFromLocalInitValue
downwardsAssignment self = const
transformAssignment self fromAbove originalAssignment fromBelow = AssignmentInstruction $ Assignment {
assignmentData = recursivelyTransformedAssignmentData fromBelow,
assignmentSemInf = convert $ assignmentSemInf originalAssignment
}
upwardsAssignment self fromAbove originalAssignment fromBelow transformedAssignment =
combine (upwardsInfoFromAssignmentLhs fromBelow) (upwardsInfoFromAssignmentRhs fromBelow)
downwardsProcedureCall self = const
transformProcedureCall self fromAbove originalProcedureCall fromBelow = ProcedureCallInstruction $ ProcedureCall {
procedureCallData = recursivelyTransformedProcedureCallData fromBelow,
procedureCallSemInf = convert $ procedureCallSemInf originalProcedureCall
}
upwardsProcedureCall self fromAbove originalProcedureCall fromBelow transformedProcedureCall =
case ul of
[] -> defaultValue
otherwise -> foldl combine (head ul) (tail ul)
where
ul = upwardsInfoFromActualParametersOfProcedureToCall fromBelow
downwardsInputActualParameter self = const
transformInputActualParameter self fromAbove originalInputActualParameter fromBelow = InputActualParameter $ InputActualParameterType {
inputActualParameterExpression = recursivelyTransformedInputActualParameterExpression fromBelow,
inputActualParameterSemInf = convert $ inputActualParameterSemInf originalInputActualParameter
}
upwardsInputActualParameter self fromAbove originalInputActualParameter fromBelow transformedInputActualParameter =
upwardsInfoFromInputActualParameter fromBelow
downwardsOutputActualParameter self = const
transformOutputActualParameter self fromAbove originalOutputActualParameter fromBelow = OutputActualParameter $ OutputActualParameterType {
outputActualParameterLeftValue = recursivelyTransformedOutputActualParameterLeftValue fromBelow,
outputActualParameterSemInf = convert $ outputActualParameterSemInf originalOutputActualParameter
}
upwardsOutputActualParameter self fromAbove originalOutputActualParameter fromBelow transformedOutputActualParameter =
upwardsInfoFromOutputActualParameterLeftValue fromBelow
downwardsVariableInLeftValue self = const
transformVariableInLeftValue self fromAbove originalVariableInLeftValue fromBelow = VariableLeftValue $ VariableInLeftValue {
variableLeftValueContents = recursivelyTransformedVariableLeftValueContents fromBelow,
variableLeftValueSemInf = convert $ variableLeftValueSemInf originalVariableInLeftValue
}
upwardsVariableInLeftValue self fromAbove originalVariableInLeftValue fromBelow transformedVariableInLeftValue =
upwardsInfoFromVariableLeftValueContents fromBelow
downwardsArrayElemReference self = const
transformArrayElemReference self fromAbove originalArrayElemReference fromBelow = ArrayElemReferenceLeftValue $ ArrayElemReference {
arrayElemReferenceData = recursivelyTransformedArrayElemReferenceData fromBelow,
arrayElemReferenceSemInf = convert $ arrayElemReferenceSemInf originalArrayElemReference
}
upwardsArrayElemReference self fromAbove originalArrayElemReference fromBelow transformedArrayElemReference =
combine (upwardsInfoFromArrayName fromBelow) (upwardsInfoFromArrayIndex fromBelow)
downwardsLeftValueExpression self = const
transformLeftValueExpression self fromAbove originalLeftValueExpression fromBelow = LeftValueExpression $ LeftValueInExpression {
leftValueExpressionContents = recursivelyTransformedLeftValueExpressionContents fromBelow,
leftValueExpressionSemInf = convert $ leftValueExpressionSemInf originalLeftValueExpression
}
upwardsLeftValueExpression self fromAbove originalLeftValueExpression fromBelow transformedLeftValueExpression =
upwardsInfoFromLeftValueExpressionContents fromBelow
downwardsFunctionCall self = const
transformFunctionCall self fromAbove originalFunctionCall fromBelow = FunctionCallExpression $ FunctionCall {
functionCallData = recursivelyTransformedFunctionCallData fromBelow,
functionCallSemInf = convert $ functionCallSemInf originalFunctionCall
}
upwardsFunctionCall self fromAbove originalFunctionCall fromBelow transformedFunctionCall = case ul of
[] -> defaultValue
otherwise -> foldl combine (head ul) (tail ul)
where ul = upwardsInfoFromActualParametersOfFunctionToCall fromBelow
transformIntConstant self fromAbove originalIntConstant = IntConstant originalIntConstant {
intConstantSemInf = convert $ intConstantSemInf originalIntConstant
}
upwardsIntConstant self fromAbove originalIntConstant transformedIntConstant = defaultValue
transformFloatConstant self fromAbove originalFloatConstant = FloatConstant originalFloatConstant {
floatConstantSemInf = convert $ floatConstantSemInf originalFloatConstant
}
upwardsFloatConstant self fromAbove originalFloatConstant transformedFloatConstant = defaultValue
transformBoolConstant self fromAbove originalBoolConstant = BoolConstant originalBoolConstant {
boolConstantSemInf = convert $ boolConstantSemInf originalBoolConstant
}
upwardsBoolConstant self fromAbove originalBoolConstant transformedBoolConstant = defaultValue
downwardsArrayConstant self = const
transformArrayConstant self fromAbove originalArrayConstant fromBelow = ArrayConstant $ ArrayConstantType {
arrayConstantValue = recursivelyTransformedArrayConstantValue fromBelow,
arrayConstantSemInf = convert $ arrayConstantSemInf originalArrayConstant
}
upwardsArrayConstant self fromAbove originalArrayConstant fromBelow transformedArrayConstant = case ul of
[] -> defaultValue
otherwise -> foldl combine (head ul) (tail ul)
where ul = upwardsInfoFromConstantList fromBelow
transformVariable self fromAbove originalVariable = originalVariable {
variableSemInf = convert $ variableSemInf originalVariable
}
upwardsVariable self fromAbove originalVariable transformedVariable = defaultValue
-- ==================================================================================================================================
-- == Walker defaults
-- ==================================================================================================================================
walkProcedure :: Walker t Procedure
walkProcedure selfpointer fromAbove construction = (transformedProcedure, toAbove)
where
toBelow = downwardsProcedure selfpointer fromAbove construction
transformedInParameters = map (walkFormalParameter selfpointer toBelow) $ inParameters construction
transformedOutParameters = map (walkFormalParameter selfpointer toBelow) $ outParameters construction
transformedProcedureBody = (walkBlock selfpointer toBelow) $ procedureBody construction
fromBelow = InfosFromProcedureParts {
recursivelyTransformedInParameters = map fst transformedInParameters,
upwardsInfoFromInParameters = map snd transformedInParameters,
recursivelyTransformedOutParameters = map fst transformedOutParameters,
upwardsInfoFromOutParameters = map snd transformedOutParameters,
recursivelyTransformedProcedureBody = fst transformedProcedureBody,
upwardsInfoFromProcedureBody = snd transformedProcedureBody
}
transformedProcedure = transformProcedure selfpointer fromAbove construction fromBelow
toAbove = upwardsProcedure selfpointer fromAbove construction fromBelow transformedProcedure
walkFormalParameter :: Walker t FormalParameter
walkFormalParameter selfpointer fromAbove p = (transformedFormalParameter, toAbove)
where
toBelow = downwardsFormalParameter selfpointer fromAbove p
transformedVariable = walkVariable selfpointer toBelow (formalParameterVariable p)
fromBelow = InfosFromFormalParameterParts {
recursivelyTransformedFormalParameterVariable = fst transformedVariable,
upwardsInfoFromFormalParameterVariable = snd transformedVariable
}
transformedFormalParameter = transformFormalParameter selfpointer fromAbove p fromBelow
toAbove = upwardsFormalParameter selfpointer fromAbove p fromBelow transformedFormalParameter
walkBlock :: Walker t Block
walkBlock selfpointer fromAbove block = (transformedBlock, toAbove)
where
toBelow = downwardsBlock selfpointer fromAbove block
transformedLocalDeclarations = map (walkLocalDeclaration selfpointer toBelow) $ blockDeclarations $ blockData block
transformedProgram = walkProgram selfpointer toBelow $ blockInstructions $ blockData block
fromBelow = InfosFromBlockParts {
recursivelyTransformedBlockData = BlockData {
blockDeclarations = map fst transformedLocalDeclarations,
blockInstructions = fst transformedProgram
},
upwardsInfoFromBlockDeclarations = map snd transformedLocalDeclarations,
upwardsInfoFromBlockInstructions = snd transformedProgram
}
transformedBlock = transformBlock selfpointer fromAbove block fromBelow
toAbove = upwardsBlock selfpointer fromAbove block fromBelow transformedBlock
walkProgram :: Walker t Program
walkProgram selfpointer fromAbove program = (transformedProgram, toAbove)
where
toBelow = downwardsProgram selfpointer fromAbove program
transformedProgramConstruction = case programConstruction program of
EmptyProgram empty -> walkEmpty selfpointer toBelow empty
PrimitiveProgram primitive -> walkPrimitive selfpointer toBelow primitive
SequenceProgram sequence -> walkSequence selfpointer toBelow sequence
BranchProgram branch -> walkBranch selfpointer toBelow branch
SequentialLoopProgram sequentialLoop -> walkSequentialLoop selfpointer toBelow sequentialLoop
ParallelLoopProgram parallelLoop -> walkParallelLoop selfpointer toBelow parallelLoop
fromBelow = InfosFromProgramParts {
recursivelyTransformedProgramConstruction = fst transformedProgramConstruction,
upwardsInfoFromProgramConstruction = snd transformedProgramConstruction
}
transformedProgram = transformProgram selfpointer fromAbove program fromBelow
toAbove = upwardsProgram selfpointer fromAbove program fromBelow transformedProgram
walkEmpty :: (TransformationPhase t) => t -> Downwards t -> Empty (From t) -> (ProgramConstruction (To t), Upwards t)
walkEmpty selfpointer fromAbove empty = (transformedEmpty, toAbove)
where
transformedEmpty = transformEmpty selfpointer fromAbove empty
toAbove = upwardsEmpty selfpointer fromAbove empty transformedEmpty
walkPrimitive :: (TransformationPhase t) => t -> Downwards t -> Primitive (From t) -> (ProgramConstruction (To t), Upwards t)
walkPrimitive selfpointer fromAbove primitive = (transformedPrimitive, toAbove)
where
toBelow = downwardsPrimitive selfpointer fromAbove primitive
transformedPrimitiveInstruction =
walkInstruction selfpointer toBelow (primitiveInstruction primitive)
fromBelow = InfosFromPrimitiveParts {
recursivelyTransformedPrimitiveInstruction = fst transformedPrimitiveInstruction,
upwardsInfoFromPrimitiveInstruction = snd transformedPrimitiveInstruction
}
transformedPrimitive = transformPrimitive selfpointer fromAbove primitive fromBelow
toAbove = upwardsPrimitive selfpointer fromAbove primitive fromBelow transformedPrimitive
walkSequence :: (TransformationPhase t) => t -> Downwards t -> Sequence (From t) -> (ProgramConstruction (To t), Upwards t)
walkSequence selfpointer fromAbove sequence = (transformedSequence, toAbove)
where
toBelow = downwardsSequence selfpointer fromAbove sequence
transformedProgramList =
map (walkProgram selfpointer toBelow) (sequenceProgramList sequence)
fromBelow = InfosFromSequenceParts {
recursivelyTransformedSequenceProgramList = map fst transformedProgramList,
upwardsInfoFromSequenceProgramList = map snd transformedProgramList
}
transformedSequence = transformSequence selfpointer fromAbove sequence fromBelow
toAbove = upwardsSequence selfpointer fromAbove sequence fromBelow transformedSequence
walkBranch :: (TransformationPhase t) => t -> Downwards t -> Branch (From t) -> (ProgramConstruction (To t), Upwards t)
walkBranch selfpointer fromAbove branch = (transformedBranch, toAbove)
where
toBelow = downwardsBranch selfpointer fromAbove branch
transformedBranchConditionVariable = walkVariable selfpointer toBelow (branchConditionVariable $ branchData branch)
transformedThenBlock = walkBlock selfpointer toBelow (thenBlock $ branchData branch)
transformedElseBlock = walkBlock selfpointer toBelow (elseBlock $ branchData branch)
fromBelow = InfosFromBranchParts {
recursivelyTransformedBranchData = BranchData {
branchConditionVariable = fst transformedBranchConditionVariable,
thenBlock = fst transformedThenBlock,
elseBlock = fst transformedElseBlock
},
upwardsInfoFromBranchConditionVariable = snd transformedBranchConditionVariable,
upwardsInfoFromThenBlock = snd transformedThenBlock,
upwardsInfoFromElseBlock = snd transformedElseBlock
}
transformedBranch = transformBranch selfpointer fromAbove branch fromBelow
toAbove = upwardsBranch selfpointer fromAbove branch fromBelow transformedBranch
walkSequentialLoop :: (TransformationPhase t) => t -> Downwards t -> SequentialLoop (From t) -> (ProgramConstruction (To t), Upwards t)
walkSequentialLoop selfpointer fromAbove loop = (transformedSequentialLoop, toAbove)
where
toBelow = downwardsSequentialLoop selfpointer fromAbove loop
transformedLoopConditionVariable =
walkExpression selfpointer toBelow (sequentialLoopCondition $ sequentialLoopData loop)
transformedConditionCalculation =
walkBlock selfpointer toBelow (conditionCalculation $ sequentialLoopData loop)
transformedSequentialLoopCore =
walkBlock selfpointer toBelow (sequentialLoopCore $ sequentialLoopData loop)
fromBelow = InfosFromSequentialLoopParts {
recursivelyTransformedSequentialLoopData = SequentialLoopData {
sequentialLoopCondition = fst transformedLoopConditionVariable,
conditionCalculation = fst transformedConditionCalculation,
sequentialLoopCore = fst transformedSequentialLoopCore
},
upwardsInfoFromSequentialLoopConditionVariable = snd transformedLoopConditionVariable,
upwardsInfoFromSequentialLoopConditionCalculation = snd transformedConditionCalculation,
upwardsInfoFromSequentialLoopCore = snd transformedSequentialLoopCore
}
transformedSequentialLoop = transformSequentialLoop selfpointer fromAbove loop fromBelow
toAbove = upwardsSequentialLoop selfpointer fromAbove loop fromBelow transformedSequentialLoop
walkParallelLoop :: (TransformationPhase t) => t -> Downwards t -> ParallelLoop (From t) -> (ProgramConstruction (To t), Upwards t)
walkParallelLoop selfpointer fromAbove loop = (transformedParallelLoop, toAbove)
where
toBelow = downwardsParallelLoop selfpointer fromAbove loop
transformedParallelLoopConditionVariable =
walkVariable selfpointer toBelow (parallelLoopConditionVariable $ parallelLoopData loop)
transformedNumberOfIterations =
walkExpression selfpointer toBelow (numberOfIterations $ parallelLoopData loop)
transformedParallelLoopCore =
walkBlock selfpointer toBelow (parallelLoopCore $ parallelLoopData loop)
fromBelow = InfosFromParallelLoopParts {
recursivelyTransformedParallelLoopData = ParallelLoopData {
parallelLoopConditionVariable = fst transformedParallelLoopConditionVariable,
numberOfIterations = fst transformedNumberOfIterations,
parallelLoopStep = parallelLoopStep $ parallelLoopData loop,
parallelLoopCore = fst transformedParallelLoopCore
},
upwardsInfoFromParallelLoopConditionVariable = snd transformedParallelLoopConditionVariable,
upwardsInfoFromNumberOfIterations = snd transformedNumberOfIterations,
upwardsInfoFromParallelLoopCore = snd transformedParallelLoopCore
}
transformedParallelLoop = transformParallelLoop selfpointer fromAbove loop fromBelow
toAbove = upwardsParallelLoop selfpointer fromAbove loop fromBelow transformedParallelLoop
walkLocalDeclaration :: Walker t LocalDeclaration
walkLocalDeclaration selfpointer fromAbove local = (transformedLocalDeclaration, toAbove)
where
toBelow = downwardsLocalDeclaration selfpointer fromAbove local
transformedLocalVariable = walkVariable selfpointer toBelow (localVariable $ localDeclarationData local)
transformedLocalInitValue = case localInitValue $ localDeclarationData local of
Nothing -> (Nothing, Nothing)
Just localInitExpression -> (Just (fst transformedLocalInitExpression), Just (snd transformedLocalInitExpression))
where transformedLocalInitExpression = walkExpression selfpointer toBelow localInitExpression
fromBelow = InfosFromLocalDeclarationParts {
recursivelyTransformedLocalDeclarationData = LocalDeclarationData {
localVariable = fst transformedLocalVariable,
localInitValue = fst transformedLocalInitValue
},
upwardsInfoFromLocalVariable = snd transformedLocalVariable,
upwardsInfoFromLocalInitValue = snd transformedLocalInitValue
}
transformedLocalDeclaration = transformLocalDeclaration selfpointer fromAbove local fromBelow
toAbove = upwardsLocalDeclaration selfpointer fromAbove local fromBelow transformedLocalDeclaration
walkExpression :: Walker t Expression
walkExpression selfpointer fromAbove expression = case expression of
LeftValueExpression leftValueExpression -> (transformedLeftValueExpression, toAbove)
where
toBelow = downwardsLeftValueExpression selfpointer fromAbove leftValueExpression
transformedLeftValueExpressionContents = walkLeftValue selfpointer
toBelow (leftValueExpressionContents leftValueExpression)
fromBelow = InfosFromLeftValueExpressionParts {
recursivelyTransformedLeftValueExpressionContents = fst transformedLeftValueExpressionContents,
upwardsInfoFromLeftValueExpressionContents = snd transformedLeftValueExpressionContents
}
transformedLeftValueExpression = transformLeftValueExpression selfpointer fromAbove leftValueExpression fromBelow
toAbove = upwardsLeftValueExpression selfpointer fromAbove leftValueExpression fromBelow transformedLeftValueExpression
ConstantExpression constant -> ((ConstantExpression $ fst transformedConstant), snd transformedConstant)
where
toBelow = fromAbove -- calculations are done in WalkConstant, used only in the ArrayConstant branch
transformedConstant = walkConstant selfpointer toBelow constant
FunctionCallExpression functionCall -> (transformedFunctionCallExpression, toAbove)
where
toBelow = downwardsFunctionCall selfpointer fromAbove functionCall
transformedActualParametersOfFunctionToCall = map
(walkExpression selfpointer toBelow)
(actualParametersOfFunctionToCall $ functionCallData functionCall)
fromBelow = InfosFromFunctionCallParts {
recursivelyTransformedFunctionCallData = (functionCallData functionCall) {
actualParametersOfFunctionToCall = map fst transformedActualParametersOfFunctionToCall
},
upwardsInfoFromActualParametersOfFunctionToCall = map snd transformedActualParametersOfFunctionToCall
}
transformedFunctionCallExpression = transformFunctionCall selfpointer fromAbove functionCall fromBelow
toAbove = upwardsFunctionCall selfpointer fromAbove functionCall fromBelow transformedFunctionCallExpression
walkConstant :: Walker t Constant
walkConstant selfpointer fromAbove constant = case constant of
IntConstant intConstant -> (transformedIntConstant, toAbove)
where
transformedIntConstant = transformIntConstant selfpointer fromAbove intConstant
toAbove = upwardsIntConstant selfpointer fromAbove intConstant transformedIntConstant
FloatConstant floatConstant -> (transformedFloatConstant, toAbove)
where
transformedFloatConstant = transformFloatConstant selfpointer fromAbove floatConstant
toAbove = upwardsFloatConstant selfpointer fromAbove floatConstant transformedFloatConstant
BoolConstant boolConstant -> (transformedBoolConstant, toAbove)
where
transformedBoolConstant = transformBoolConstant selfpointer fromAbove boolConstant
toAbove = upwardsBoolConstant selfpointer fromAbove boolConstant transformedBoolConstant
ArrayConstant arrayConstant -> (transformedArrayConstant, toAbove)
where
toBelow = downwardsArrayConstant selfpointer fromAbove arrayConstant
transformedConstantList = map (walkConstant selfpointer toBelow) (arrayConstantValue arrayConstant)
fromBelow = InfosFromArrayConstantParts {
recursivelyTransformedArrayConstantValue = map fst transformedConstantList,
upwardsInfoFromConstantList = map snd transformedConstantList
}
transformedArrayConstant = transformArrayConstant selfpointer fromAbove arrayConstant fromBelow
toAbove = upwardsArrayConstant selfpointer fromAbove arrayConstant fromBelow transformedArrayConstant
walkLeftValue :: Walker t LeftValue
walkLeftValue selfpointer fromAbove leftValue = case leftValue of
VariableLeftValue lvt -> (transformedVariableLeftValue, toAbove)
where
toBelow = downwardsVariableInLeftValue selfpointer fromAbove lvt
transformedVariableLeftValueContents =
walkVariable selfpointer toBelow (variableLeftValueContents lvt)
fromBelow = InfosFromVariableLeftValueParts {
recursivelyTransformedVariableLeftValueContents = fst transformedVariableLeftValueContents,
upwardsInfoFromVariableLeftValueContents = snd transformedVariableLeftValueContents
}
transformedVariableLeftValue = transformVariableInLeftValue selfpointer fromAbove lvt fromBelow
toAbove = upwardsVariableInLeftValue selfpointer fromAbove lvt fromBelow transformedVariableLeftValue
ArrayElemReferenceLeftValue arrayElemReference -> (transformedArrayElemReference, toAbove)
where
toBelow = downwardsArrayElemReference selfpointer fromAbove arrayElemReference
transformedArrayName =
walkLeftValue selfpointer toBelow (arrayName $ arrayElemReferenceData arrayElemReference)
transformedArrayIndex =
walkExpression selfpointer toBelow (arrayIndex $ arrayElemReferenceData arrayElemReference)
fromBelow = InfosFromArrayElemReferenceParts {
recursivelyTransformedArrayElemReferenceData = ArrayElemReferenceData {
arrayName = fst transformedArrayName,
arrayIndex = fst transformedArrayIndex
},
upwardsInfoFromArrayName = snd transformedArrayName,
upwardsInfoFromArrayIndex = snd transformedArrayIndex
}
transformedArrayElemReference = transformArrayElemReference selfpointer fromAbove arrayElemReference fromBelow
toAbove = upwardsArrayElemReference selfpointer fromAbove arrayElemReference fromBelow transformedArrayElemReference
walkActualParameter :: Walker t ActualParameter
walkActualParameter selfpointer fromAbove actualParameter = case actualParameter of
InputActualParameter input -> (transformedInputActualParameter, toAbove)
where
toBelow = downwardsInputActualParameter selfpointer fromAbove input
transformedInputActualParameterExpression =
walkExpression selfpointer toBelow (inputActualParameterExpression input)
fromBelow = InfosFromInputActualParameterParts {
recursivelyTransformedInputActualParameterExpression = fst transformedInputActualParameterExpression,
upwardsInfoFromInputActualParameter = snd transformedInputActualParameterExpression
}
transformedInputActualParameter = transformInputActualParameter selfpointer fromAbove input fromBelow
toAbove = upwardsInputActualParameter selfpointer fromAbove input fromBelow transformedInputActualParameter
OutputActualParameter output -> (transformedOutputActualParameter, toAbove)
where
toBelow = downwardsOutputActualParameter selfpointer fromAbove output
transformedOutputActualParameterLeftValue =
walkLeftValue selfpointer toBelow (outputActualParameterLeftValue output)
fromBelow = InfosFromOutputActualParameterParts {
recursivelyTransformedOutputActualParameterLeftValue = fst transformedOutputActualParameterLeftValue,
upwardsInfoFromOutputActualParameterLeftValue = snd transformedOutputActualParameterLeftValue
}
transformedOutputActualParameter = transformOutputActualParameter selfpointer fromAbove output fromBelow
toAbove = upwardsOutputActualParameter selfpointer fromAbove output fromBelow transformedOutputActualParameter
walkInstruction :: Walker t Instruction
walkInstruction selfpointer fromAbove instruction = case instruction of
AssignmentInstruction assignment -> (transformedAssignment, toAbove)
where
toBelow = downwardsAssignment selfpointer fromAbove assignment
transformedAssignmentLhs = walkLeftValue selfpointer toBelow (assignmentLhs $ assignmentData assignment)
transformedAssignmentRhs = walkExpression selfpointer toBelow (assignmentRhs $ assignmentData assignment)
fromBelow = InfosFromAssignmentParts {
recursivelyTransformedAssignmentData = AssignmentData {
assignmentLhs = fst transformedAssignmentLhs,
assignmentRhs = fst transformedAssignmentRhs
},
upwardsInfoFromAssignmentLhs = snd transformedAssignmentLhs,
upwardsInfoFromAssignmentRhs = snd transformedAssignmentRhs
}
transformedAssignment = transformAssignment selfpointer fromAbove assignment fromBelow
toAbove = upwardsAssignment selfpointer fromAbove assignment fromBelow transformedAssignment
ProcedureCallInstruction procedureCall -> (transformedProcedureCall, toAbove)
where
toBelow = downwardsProcedureCall selfpointer fromAbove procedureCall
transformedActualParametersOfProcedureToCall = map (walkActualParameter selfpointer toBelow)
(actualParametersOfProcedureToCall $ procedureCallData procedureCall)
fromBelow = InfosFromProcedureCallParts {
recursivelyTransformedProcedureCallData = (procedureCallData procedureCall) {
actualParametersOfProcedureToCall = map fst transformedActualParametersOfProcedureToCall
},
upwardsInfoFromActualParametersOfProcedureToCall = map snd transformedActualParametersOfProcedureToCall
}
transformedProcedureCall = transformProcedureCall selfpointer fromAbove procedureCall fromBelow
toAbove = upwardsProcedureCall selfpointer fromAbove procedureCall fromBelow transformedProcedureCall
walkVariable :: Walker t Variable
walkVariable selfpointer fromAbove v = (transformedVariable, toAbove)
where
transformedVariable = transformVariable selfpointer fromAbove v
toAbove = upwardsVariable selfpointer fromAbove v transformedVariable
-- ==================================================================================================================================
-- == Upwards infos
-- ==================================================================================================================================
data (TransformationPhase t) => InfosFromProcedureParts t = InfosFromProcedureParts {
recursivelyTransformedInParameters :: [FormalParameter (To t)],
upwardsInfoFromInParameters :: [Upwards t],
recursivelyTransformedOutParameters :: [FormalParameter (To t)],
upwardsInfoFromOutParameters :: [Upwards t],
recursivelyTransformedProcedureBody :: Block (To t),
upwardsInfoFromProcedureBody :: Upwards t
}
data (TransformationPhase t) => InfosFromBlockParts t = InfosFromBlockParts {
recursivelyTransformedBlockData :: BlockData (To t),
upwardsInfoFromBlockDeclarations :: [Upwards t],
upwardsInfoFromBlockInstructions :: Upwards t
}
data (TransformationPhase t) => InfosFromProgramParts t = InfosFromProgramParts {
recursivelyTransformedProgramConstruction :: ProgramConstruction (To t),
upwardsInfoFromProgramConstruction :: Upwards t
}
data (TransformationPhase t) => InfosFromPrimitiveParts t = InfosFromPrimitiveParts {
recursivelyTransformedPrimitiveInstruction :: Instruction (To t),
upwardsInfoFromPrimitiveInstruction :: Upwards t
}
data (TransformationPhase t) => InfosFromSequenceParts t = InfosFromSequenceParts {
recursivelyTransformedSequenceProgramList :: [Program (To t)],
upwardsInfoFromSequenceProgramList :: [Upwards t]
}
data (TransformationPhase t) => InfosFromBranchParts t = InfosFromBranchParts {
recursivelyTransformedBranchData :: BranchData (To t),
upwardsInfoFromBranchConditionVariable :: Upwards t,
upwardsInfoFromThenBlock :: Upwards t,
upwardsInfoFromElseBlock :: Upwards t
}
data (TransformationPhase t) => InfosFromSequentialLoopParts t = InfosFromSequentialLoopParts {
recursivelyTransformedSequentialLoopData :: SequentialLoopData (To t),
upwardsInfoFromSequentialLoopConditionVariable :: Upwards t,
upwardsInfoFromSequentialLoopConditionCalculation :: Upwards t,
upwardsInfoFromSequentialLoopCore :: Upwards t
}
data (TransformationPhase t) => InfosFromParallelLoopParts t = InfosFromParallelLoopParts {
recursivelyTransformedParallelLoopData :: ParallelLoopData (To t),
upwardsInfoFromParallelLoopConditionVariable :: Upwards t,
upwardsInfoFromNumberOfIterations :: Upwards t,
upwardsInfoFromParallelLoopCore :: Upwards t
}
data (TransformationPhase t) => InfosFromFormalParameterParts t = InfosFromFormalParameterParts {
recursivelyTransformedFormalParameterVariable :: Variable (To t),
upwardsInfoFromFormalParameterVariable :: Upwards t
}
data (TransformationPhase t) => InfosFromLocalDeclarationParts t = InfosFromLocalDeclarationParts {
recursivelyTransformedLocalDeclarationData :: LocalDeclarationData (To t),
upwardsInfoFromLocalVariable :: Upwards t,
upwardsInfoFromLocalInitValue :: Maybe (Upwards t)
}
data (TransformationPhase t) => InfosFromAssignmentParts t = InfosFromAssignmentParts {
recursivelyTransformedAssignmentData :: AssignmentData (To t),
upwardsInfoFromAssignmentLhs :: Upwards t,
upwardsInfoFromAssignmentRhs :: Upwards t
}
data (TransformationPhase t) => InfosFromProcedureCallParts t = InfosFromProcedureCallParts {
recursivelyTransformedProcedureCallData :: ProcedureCallData (To t),
upwardsInfoFromActualParametersOfProcedureToCall :: [Upwards t]
}
data (TransformationPhase t) => InfosFromInputActualParameterParts t = InfosFromInputActualParameterParts {
recursivelyTransformedInputActualParameterExpression :: Expression (To t),
upwardsInfoFromInputActualParameter :: Upwards t
}
data (TransformationPhase t) => InfosFromOutputActualParameterParts t = InfosFromOutputActualParameterParts {
recursivelyTransformedOutputActualParameterLeftValue :: LeftValue (To t),
upwardsInfoFromOutputActualParameterLeftValue :: Upwards t
}
data (TransformationPhase t) => InfosFromArrayElemReferenceParts t = InfosFromArrayElemReferenceParts {
recursivelyTransformedArrayElemReferenceData :: ArrayElemReferenceData (To t),
upwardsInfoFromArrayName :: Upwards t,
upwardsInfoFromArrayIndex :: Upwards t
}
data (TransformationPhase t) => InfosFromVariableLeftValueParts t = InfosFromVariableLeftValueParts {
recursivelyTransformedVariableLeftValueContents :: Variable (To t),
upwardsInfoFromVariableLeftValueContents :: Upwards t
}
data (TransformationPhase t) => InfosFromLeftValueExpressionParts t = InfosFromLeftValueExpressionParts {
recursivelyTransformedLeftValueExpressionContents :: LeftValue (To t),
upwardsInfoFromLeftValueExpressionContents :: Upwards t
}
data (TransformationPhase t) => InfosFromFunctionCallParts t = InfosFromFunctionCallParts {
recursivelyTransformedFunctionCallData :: FunctionCallData (To t),
upwardsInfoFromActualParametersOfFunctionToCall :: [Upwards t]
}
data (TransformationPhase t) => InfosFromArrayConstantParts t = InfosFromArrayConstantParts {
recursivelyTransformedArrayConstantValue :: [Constant (To t)],
upwardsInfoFromConstantList :: [Upwards t]
}