--
-- Copyright (c) 2009-2010, ERICSSON AB All rights reserved.
-- 
-- Redistribution and use in source and binary forms, with or without
-- modification, are permitted provided that the following conditions are met:
-- 
--     * Redistributions of source code must retain the above copyright notice,
--       this list of conditions and the following disclaimer.
--     * Redistributions in binary form must reproduce the above copyright
--       notice, this list of conditions and the following disclaimer in the
--       documentation and/or other materials provided with the distribution.
--     * Neither the name of the ERICSSON AB nor the names of its contributors
--       may be used to endorse or promote products derived from this software
--       without specific prior written permission.
-- 
-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
-- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS
-- BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY,
-- OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
-- THE POSSIBILITY OF SUCH DAMAGE.
--

{-# 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

foldlist :: (Default a, Combine a) => [a] -> a
foldlist ul = case ul of
    [] -> defaultValue
    otherwise -> foldl combine (head ul) (tail ul)
    
convertMaybeList :: Maybe [a] -> [a]
convertMaybeList ul = case ul of
    Nothing -> []
    Just x -> x

convertMaybe :: Maybe a -> [a]
convertMaybe ul = case ul of
    Nothing -> []
    Just x -> [x]


-- ==================================================================================================================================
--  == 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 (downwards-transform-upwards)
-- ====================================================================================================
    -- ====================================================================================================
    --   == Node transformers for Procedure
    -- ====================================================================================================
    downwardsProcedure :: t -> Downwards t -> Procedure (From t) -> Downwards t
    downwardsProcedure self = const
    transformProcedure :: t -> Downwards t -> Procedure (From t) -> InfoFromProcedureParts t -> Procedure (To t)
    transformProcedure self fromAbove originalProcedure fromBelow = originalProcedure {
        inParameters = recursivelyTransformedInParameters fromBelow,
        outParameters = recursivelyTransformedOutParameters fromBelow,
        procedureBody = recursivelyTransformedProcedureBody fromBelow,
        procedureSemInf = convert $ procedureSemInf originalProcedure
    }
    upwardsProcedure :: t -> Downwards t -> Procedure (From t) -> InfoFromProcedureParts t -> Procedure (To t) -> Upwards t
    upwardsProcedure self fromAbove originalProcedure fromBelow transformedProcedure = foldlist ((upwardsInfoFromInParameters fromBelow) ++ (upwardsInfoFromOutParameters fromBelow) ++ [(upwardsInfoFromProcedureBody fromBelow)])
    -- ====================================================================================================
    --   == Node transformers for Block
    -- ====================================================================================================
    downwardsBlock :: t -> Downwards t -> Block (From t) -> Downwards t
    downwardsBlock self = const
    transformBlock :: t -> Downwards t -> Block (From t) -> InfoFromBlockParts t -> Block (To t)
    transformBlock self fromAbove originalBlock fromBelow = originalBlock {
        blockDeclarations = recursivelyTransformedBlockDeclarations fromBelow,
        blockInstructions = recursivelyTransformedBlockInstructions fromBelow,
        blockSemInf = convert $ blockSemInf originalBlock
    }
    upwardsBlock :: t -> Downwards t -> Block (From t) -> InfoFromBlockParts t -> Block (To t) -> Upwards t
    upwardsBlock self fromAbove originalBlock fromBelow transformedBlock = foldlist ((upwardsInfoFromBlockDeclarations fromBelow) ++ [(upwardsInfoFromBlockInstructions fromBelow)])
    -- ====================================================================================================
    --   == Node transformers for Program
    -- ====================================================================================================
    downwardsProgram :: t -> Downwards t -> Program (From t) -> Downwards t
    downwardsProgram self = const
    transformProgram :: t -> Downwards t -> Program (From t) -> InfoFromProgramParts t -> Program (To t)
    transformProgram self fromAbove originalProgram fromBelow = originalProgram {
        programConstruction = recursivelyTransformedProgramConstruction fromBelow,
        programSemInf = convert $ programSemInf originalProgram
    }
    upwardsProgram :: t -> Downwards t -> Program (From t) -> InfoFromProgramParts t -> Program (To t) -> Upwards t
    upwardsProgram self fromAbove originalProgram fromBelow transformedProgram = foldlist ([(upwardsInfoFromProgramConstruction fromBelow)])
    -- ====================================================================================================
    --   == Node transformers for Empty(current basetype: ProgramConstruction)
    -- ====================================================================================================
    transformEmptyProgramInProgram :: t -> Downwards t -> Empty (From t) -> ProgramConstruction (To t)
    transformEmptyProgramInProgram self fromAbove originalEmpty = EmptyProgram $ originalEmpty {
        emptySemInf = convert $ emptySemInf originalEmpty
    }
    upwardsEmptyProgramInProgram :: t -> Downwards t -> Empty (From t) -> ProgramConstruction (To t) -> Upwards t
    upwardsEmptyProgramInProgram self fromAbove originalEmpty transformedEmpty = defaultValue
    -- ====================================================================================================
    --   == Node transformers for Primitive(current basetype: ProgramConstruction)
    -- ====================================================================================================
    downwardsPrimitiveProgramInProgram :: t -> Downwards t -> Primitive (From t) -> Downwards t
    downwardsPrimitiveProgramInProgram self = const
    transformPrimitiveProgramInProgram :: t -> Downwards t -> Primitive (From t) -> InfoFromPrimitiveParts t -> ProgramConstruction (To t)
    transformPrimitiveProgramInProgram self fromAbove originalPrimitive fromBelow = PrimitiveProgram $ originalPrimitive {
        primitiveInstruction = recursivelyTransformedPrimitiveInstruction fromBelow,
        primitiveSemInf = convert $ primitiveSemInf originalPrimitive
    }
    upwardsPrimitiveProgramInProgram :: t -> Downwards t -> Primitive (From t) -> InfoFromPrimitiveParts t -> ProgramConstruction (To t) -> Upwards t
    upwardsPrimitiveProgramInProgram self fromAbove originalPrimitive fromBelow transformedPrimitive = foldlist ([(upwardsInfoFromPrimitiveInstruction fromBelow)])
    -- ====================================================================================================
    --   == Node transformers for Sequence(current basetype: ProgramConstruction)
    -- ====================================================================================================
    downwardsSequenceProgramInProgram :: t -> Downwards t -> Sequence (From t) -> Downwards t
    downwardsSequenceProgramInProgram self = const
    transformSequenceProgramInProgram :: t -> Downwards t -> Sequence (From t) -> InfoFromSequenceParts t -> ProgramConstruction (To t)
    transformSequenceProgramInProgram self fromAbove originalSequence fromBelow = SequenceProgram $ originalSequence {
        sequenceProgramList = recursivelyTransformedSequenceProgramList fromBelow,
        sequenceSemInf = convert $ sequenceSemInf originalSequence
    }
    upwardsSequenceProgramInProgram :: t -> Downwards t -> Sequence (From t) -> InfoFromSequenceParts t -> ProgramConstruction (To t) -> Upwards t
    upwardsSequenceProgramInProgram self fromAbove originalSequence fromBelow transformedSequence = foldlist ((upwardsInfoFromSequenceProgramList fromBelow))
    -- ====================================================================================================
    --   == Node transformers for Branch(current basetype: ProgramConstruction)
    -- ====================================================================================================
    downwardsBranchProgramInProgram :: t -> Downwards t -> Branch (From t) -> Downwards t
    downwardsBranchProgramInProgram self = const
    transformBranchProgramInProgram :: t -> Downwards t -> Branch (From t) -> InfoFromBranchParts t -> ProgramConstruction (To t)
    transformBranchProgramInProgram self fromAbove originalBranch fromBelow = BranchProgram $ originalBranch {
        branchConditionVariable = recursivelyTransformedBranchConditionVariable fromBelow,
        thenBlock = recursivelyTransformedThenBlock fromBelow,
        elseBlock = recursivelyTransformedElseBlock fromBelow,
        branchSemInf = convert $ branchSemInf originalBranch
    }
    upwardsBranchProgramInProgram :: t -> Downwards t -> Branch (From t) -> InfoFromBranchParts t -> ProgramConstruction (To t) -> Upwards t
    upwardsBranchProgramInProgram self fromAbove originalBranch fromBelow transformedBranch = foldlist ([(upwardsInfoFromBranchConditionVariable fromBelow)] ++ [(upwardsInfoFromThenBlock fromBelow)] ++ [(upwardsInfoFromElseBlock fromBelow)])
    -- ====================================================================================================
    --   == Node transformers for SequentialLoop(current basetype: ProgramConstruction)
    -- ====================================================================================================
    downwardsSequentialLoopProgramInProgram :: t -> Downwards t -> SequentialLoop (From t) -> Downwards t
    downwardsSequentialLoopProgramInProgram self = const
    transformSequentialLoopProgramInProgram :: t -> Downwards t -> SequentialLoop (From t) -> InfoFromSequentialLoopParts t -> ProgramConstruction (To t)
    transformSequentialLoopProgramInProgram self fromAbove originalSequentialLoop fromBelow = SequentialLoopProgram $ originalSequentialLoop {
        sequentialLoopCondition = recursivelyTransformedSequentialLoopCondition fromBelow,
        conditionCalculation = recursivelyTransformedConditionCalculation fromBelow,
        sequentialLoopCore = recursivelyTransformedSequentialLoopCore fromBelow,
        sequentialLoopSemInf = convert $ sequentialLoopSemInf originalSequentialLoop
    }
    upwardsSequentialLoopProgramInProgram :: t -> Downwards t -> SequentialLoop (From t) -> InfoFromSequentialLoopParts t -> ProgramConstruction (To t) -> Upwards t
    upwardsSequentialLoopProgramInProgram self fromAbove originalSequentialLoop fromBelow transformedSequentialLoop = foldlist ([(upwardsInfoFromSequentialLoopCondition fromBelow)] ++ [(upwardsInfoFromConditionCalculation fromBelow)] ++ [(upwardsInfoFromSequentialLoopCore fromBelow)])
    -- ====================================================================================================
    --   == Node transformers for ParallelLoop(current basetype: ProgramConstruction)
    -- ====================================================================================================
    downwardsParallelLoopProgramInProgram :: t -> Downwards t -> ParallelLoop (From t) -> Downwards t
    downwardsParallelLoopProgramInProgram self = const
    transformParallelLoopProgramInProgram :: t -> Downwards t -> ParallelLoop (From t) -> InfoFromParallelLoopParts t -> ProgramConstruction (To t)
    transformParallelLoopProgramInProgram self fromAbove originalParallelLoop fromBelow = ParallelLoopProgram $ originalParallelLoop {
        parallelLoopConditionVariable = recursivelyTransformedParallelLoopConditionVariable fromBelow,
        numberOfIterations = recursivelyTransformedNumberOfIterations fromBelow,
        parallelLoopCore = recursivelyTransformedParallelLoopCore fromBelow,
        parallelLoopSemInf = convert $ parallelLoopSemInf originalParallelLoop
    }
    upwardsParallelLoopProgramInProgram :: t -> Downwards t -> ParallelLoop (From t) -> InfoFromParallelLoopParts t -> ProgramConstruction (To t) -> Upwards t
    upwardsParallelLoopProgramInProgram self fromAbove originalParallelLoop fromBelow transformedParallelLoop = foldlist ([(upwardsInfoFromParallelLoopConditionVariable fromBelow)] ++ [(upwardsInfoFromNumberOfIterations fromBelow)] ++ [(upwardsInfoFromParallelLoopCore fromBelow)])
    -- ====================================================================================================
    --   == Node transformers for FormalParameter
    -- ====================================================================================================
    downwardsFormalParameter :: t -> Downwards t -> FormalParameter (From t) -> Downwards t
    downwardsFormalParameter self = const
    transformFormalParameter :: t -> Downwards t -> FormalParameter (From t) -> InfoFromFormalParameterParts t -> FormalParameter (To t)
    transformFormalParameter self fromAbove originalFormalParameter fromBelow = originalFormalParameter {
        formalParameterVariable = recursivelyTransformedFormalParameterVariable fromBelow,
        formalParameterSemInf = convert $ formalParameterSemInf originalFormalParameter
    }
    upwardsFormalParameter :: t -> Downwards t -> FormalParameter (From t) -> InfoFromFormalParameterParts t -> FormalParameter (To t) -> Upwards t
    upwardsFormalParameter self fromAbove originalFormalParameter fromBelow transformedFormalParameter = foldlist ([(upwardsInfoFromFormalParameterVariable fromBelow)])
    -- ====================================================================================================
    --   == Node transformers for LocalDeclaration
    -- ====================================================================================================
    downwardsLocalDeclaration :: t -> Downwards t -> LocalDeclaration (From t) -> Downwards t
    downwardsLocalDeclaration self = const
    transformLocalDeclaration :: t -> Downwards t -> LocalDeclaration (From t) -> InfoFromLocalDeclarationParts t -> LocalDeclaration (To t)
    transformLocalDeclaration self fromAbove originalLocalDeclaration fromBelow = originalLocalDeclaration {
        localVariable = recursivelyTransformedLocalVariable fromBelow,
        localInitValue = recursivelyTransformedLocalInitValue fromBelow,
        localDeclarationSemInf = convert $ localDeclarationSemInf originalLocalDeclaration
    }
    upwardsLocalDeclaration :: t -> Downwards t -> LocalDeclaration (From t) -> InfoFromLocalDeclarationParts t -> LocalDeclaration (To t) -> Upwards t
    upwardsLocalDeclaration self fromAbove originalLocalDeclaration fromBelow transformedLocalDeclaration = foldlist ([(upwardsInfoFromLocalVariable fromBelow)] ++ convertMaybe (upwardsInfoFromLocalInitValue fromBelow))
    -- ====================================================================================================
    --   == Node transformers for Expression
    -- ====================================================================================================
    downwardsExpression :: t -> Downwards t -> Expression (From t) -> Downwards t
    downwardsExpression self = const
    transformExpression :: t -> Downwards t -> Expression (From t) -> InfoFromExpressionParts t -> Expression (To t)
    transformExpression self fromAbove originalExpression fromBelow = originalExpression {
        expressionData = recursivelyTransformedExpressionData fromBelow,
        expressionSemInf = convert $ expressionSemInf originalExpression
    }
    upwardsExpression :: t -> Downwards t -> Expression (From t) -> InfoFromExpressionParts t -> Expression (To t) -> Upwards t
    upwardsExpression self fromAbove originalExpression fromBelow transformedExpression = foldlist ([(upwardsInfoFromExpressionData fromBelow)])
    -- ====================================================================================================
    --   == Node transformers for LeftValue(current basetype: ExpressionData)
    -- ====================================================================================================
    downwardsLeftValueExpressionInExpression :: t -> Downwards t -> LeftValue (From t) -> Downwards t
    downwardsLeftValueExpressionInExpression self = const
    transformLeftValueExpressionInExpression :: t -> Downwards t -> LeftValue (From t) -> InfoFromLeftValueParts t -> ExpressionData (To t)
    transformLeftValueExpressionInExpression self fromAbove originalLeftValue fromBelow = LeftValueExpression $ originalLeftValue {
        leftValueData = recursivelyTransformedLeftValueData fromBelow,
        leftValueSemInf = convert $ leftValueSemInf originalLeftValue
    }
    upwardsLeftValueExpressionInExpression :: t -> Downwards t -> LeftValue (From t) -> InfoFromLeftValueParts t -> ExpressionData (To t) -> Upwards t
    upwardsLeftValueExpressionInExpression self fromAbove originalLeftValue fromBelow transformedLeftValue = foldlist ([(upwardsInfoFromLeftValueData fromBelow)])
    -- ====================================================================================================
    --   == Node transformers for Constant(current basetype: ExpressionData)
    -- ====================================================================================================
    downwardsConstantExpressionInExpression :: t -> Downwards t -> Constant (From t) -> Downwards t
    downwardsConstantExpressionInExpression self = const
    transformConstantExpressionInExpression :: t -> Downwards t -> Constant (From t) -> InfoFromConstantParts t -> ExpressionData (To t)
    transformConstantExpressionInExpression self fromAbove originalConstant fromBelow = ConstantExpression $ originalConstant {
        constantData = recursivelyTransformedConstantData fromBelow,
        constantSemInf = convert $ constantSemInf originalConstant
    }
    upwardsConstantExpressionInExpression :: t -> Downwards t -> Constant (From t) -> InfoFromConstantParts t -> ExpressionData (To t) -> Upwards t
    upwardsConstantExpressionInExpression self fromAbove originalConstant fromBelow transformedConstant = foldlist ([(upwardsInfoFromConstantData fromBelow)])
    -- ====================================================================================================
    --   == Node transformers for FunctionCall(current basetype: ExpressionData)
    -- ====================================================================================================
    downwardsFunctionCallExpressionInExpression :: t -> Downwards t -> FunctionCall (From t) -> Downwards t
    downwardsFunctionCallExpressionInExpression self = const
    transformFunctionCallExpressionInExpression :: t -> Downwards t -> FunctionCall (From t) -> InfoFromFunctionCallParts t -> ExpressionData (To t)
    transformFunctionCallExpressionInExpression self fromAbove originalFunctionCall fromBelow = FunctionCallExpression $ originalFunctionCall {
        actualParametersOfFunctionToCall = recursivelyTransformedActualParametersOfFunctionToCall fromBelow,
        functionCallSemInf = convert $ functionCallSemInf originalFunctionCall
    }
    upwardsFunctionCallExpressionInExpression :: t -> Downwards t -> FunctionCall (From t) -> InfoFromFunctionCallParts t -> ExpressionData (To t) -> Upwards t
    upwardsFunctionCallExpressionInExpression self fromAbove originalFunctionCall fromBelow transformedFunctionCall = foldlist ((upwardsInfoFromActualParametersOfFunctionToCall fromBelow))
    -- ====================================================================================================
    --   == Node transformers for Constant
    -- ====================================================================================================
    downwardsConstant :: t -> Downwards t -> Constant (From t) -> Downwards t
    downwardsConstant self = const
    transformConstant :: t -> Downwards t -> Constant (From t) -> InfoFromConstantParts t -> Constant (To t)
    transformConstant self fromAbove originalConstant fromBelow = originalConstant {
        constantData = recursivelyTransformedConstantData fromBelow,
        constantSemInf = convert $ constantSemInf originalConstant
    }
    upwardsConstant :: t -> Downwards t -> Constant (From t) -> InfoFromConstantParts t -> Constant (To t) -> Upwards t
    upwardsConstant self fromAbove originalConstant fromBelow transformedConstant = foldlist ([(upwardsInfoFromConstantData fromBelow)])
    -- ====================================================================================================
    --   == Node transformers for IntConstantType(current basetype: ConstantData)
    -- ====================================================================================================
    transformIntConstantInConstant :: t -> Downwards t -> IntConstantType (From t) -> ConstantData (To t)
    transformIntConstantInConstant self fromAbove originalIntConstantType = IntConstant $ originalIntConstantType {
        intConstantSemInf = convert $ intConstantSemInf originalIntConstantType
    }
    upwardsIntConstantInConstant :: t -> Downwards t -> IntConstantType (From t) -> ConstantData (To t) -> Upwards t
    upwardsIntConstantInConstant self fromAbove originalIntConstantType transformedIntConstantType = defaultValue
    -- ====================================================================================================
    --   == Node transformers for FloatConstantType(current basetype: ConstantData)
    -- ====================================================================================================
    transformFloatConstantInConstant :: t -> Downwards t -> FloatConstantType (From t) -> ConstantData (To t)
    transformFloatConstantInConstant self fromAbove originalFloatConstantType = FloatConstant $ originalFloatConstantType {
        floatConstantSemInf = convert $ floatConstantSemInf originalFloatConstantType
    }
    upwardsFloatConstantInConstant :: t -> Downwards t -> FloatConstantType (From t) -> ConstantData (To t) -> Upwards t
    upwardsFloatConstantInConstant self fromAbove originalFloatConstantType transformedFloatConstantType = defaultValue
    -- ====================================================================================================
    --   == Node transformers for BoolConstantType(current basetype: ConstantData)
    -- ====================================================================================================
    transformBoolConstantInConstant :: t -> Downwards t -> BoolConstantType (From t) -> ConstantData (To t)
    transformBoolConstantInConstant self fromAbove originalBoolConstantType = BoolConstant $ originalBoolConstantType {
        boolConstantSemInf = convert $ boolConstantSemInf originalBoolConstantType
    }
    upwardsBoolConstantInConstant :: t -> Downwards t -> BoolConstantType (From t) -> ConstantData (To t) -> Upwards t
    upwardsBoolConstantInConstant self fromAbove originalBoolConstantType transformedBoolConstantType = defaultValue
    -- ====================================================================================================
    --   == Node transformers for ArrayConstantType(current basetype: ConstantData)
    -- ====================================================================================================
    downwardsArrayConstantInConstant :: t -> Downwards t -> ArrayConstantType (From t) -> Downwards t
    downwardsArrayConstantInConstant self = const
    transformArrayConstantInConstant :: t -> Downwards t -> ArrayConstantType (From t) -> InfoFromArrayConstantParts t -> ConstantData (To t)
    transformArrayConstantInConstant self fromAbove originalArrayConstantType fromBelow = ArrayConstant $ originalArrayConstantType {
        arrayConstantValue = recursivelyTransformedArrayConstantValue fromBelow,
        arrayConstantSemInf = convert $ arrayConstantSemInf originalArrayConstantType
    }
    upwardsArrayConstantInConstant :: t -> Downwards t -> ArrayConstantType (From t) -> InfoFromArrayConstantParts t -> ConstantData (To t) -> Upwards t
    upwardsArrayConstantInConstant self fromAbove originalArrayConstantType fromBelow transformedArrayConstantType = foldlist ((upwardsInfoFromArrayConstantValue fromBelow))
    -- ====================================================================================================
    --   == Node transformers for LeftValue
    -- ====================================================================================================
    downwardsLeftValue :: t -> Downwards t -> LeftValue (From t) -> Downwards t
    downwardsLeftValue self = const
    transformLeftValue :: t -> Downwards t -> LeftValue (From t) -> InfoFromLeftValueParts t -> LeftValue (To t)
    transformLeftValue self fromAbove originalLeftValue fromBelow = originalLeftValue {
        leftValueData = recursivelyTransformedLeftValueData fromBelow,
        leftValueSemInf = convert $ leftValueSemInf originalLeftValue
    }
    upwardsLeftValue :: t -> Downwards t -> LeftValue (From t) -> InfoFromLeftValueParts t -> LeftValue (To t) -> Upwards t
    upwardsLeftValue self fromAbove originalLeftValue fromBelow transformedLeftValue = foldlist ([(upwardsInfoFromLeftValueData fromBelow)])
    -- ====================================================================================================
    --   == Node transformers for Variable(current basetype: LeftValueData)
    -- ====================================================================================================
    transformVariableLeftValueInLeftValue :: t -> Downwards t -> Variable (From t) -> LeftValueData (To t)
    transformVariableLeftValueInLeftValue self fromAbove originalVariable = VariableLeftValue $ originalVariable {
        variableSemInf = convert $ variableSemInf originalVariable
    }
    upwardsVariableLeftValueInLeftValue :: t -> Downwards t -> Variable (From t) -> LeftValueData (To t) -> Upwards t
    upwardsVariableLeftValueInLeftValue self fromAbove originalVariable transformedVariable = defaultValue
    -- ====================================================================================================
    --   == Node transformers for ArrayElemReference(current basetype: LeftValueData)
    -- ====================================================================================================
    downwardsArrayElemReferenceLeftValueInLeftValue :: t -> Downwards t -> ArrayElemReference (From t) -> Downwards t
    downwardsArrayElemReferenceLeftValueInLeftValue self = const
    transformArrayElemReferenceLeftValueInLeftValue :: t -> Downwards t -> ArrayElemReference (From t) -> InfoFromArrayElemReferenceParts t -> LeftValueData (To t)
    transformArrayElemReferenceLeftValueInLeftValue self fromAbove originalArrayElemReference fromBelow = ArrayElemReferenceLeftValue $ originalArrayElemReference {
        arrayName = recursivelyTransformedArrayName fromBelow,
        arrayIndex = recursivelyTransformedArrayIndex fromBelow,
        arrayElemReferenceSemInf = convert $ arrayElemReferenceSemInf originalArrayElemReference
    }
    upwardsArrayElemReferenceLeftValueInLeftValue :: t -> Downwards t -> ArrayElemReference (From t) -> InfoFromArrayElemReferenceParts t -> LeftValueData (To t) -> Upwards t
    upwardsArrayElemReferenceLeftValueInLeftValue self fromAbove originalArrayElemReference fromBelow transformedArrayElemReference = foldlist ([(upwardsInfoFromArrayName fromBelow)] ++ [(upwardsInfoFromArrayIndex fromBelow)])
    -- ====================================================================================================
    --   == Node transformers for Instruction
    -- ====================================================================================================
    downwardsInstruction :: t -> Downwards t -> Instruction (From t) -> Downwards t
    downwardsInstruction self = const
    transformInstruction :: t -> Downwards t -> Instruction (From t) -> InfoFromInstructionParts t -> Instruction (To t)
    transformInstruction self fromAbove originalInstruction fromBelow = originalInstruction {
        instructionData = recursivelyTransformedInstructionData fromBelow,
        instructionSemInf = convert $ instructionSemInf originalInstruction
    }
    upwardsInstruction :: t -> Downwards t -> Instruction (From t) -> InfoFromInstructionParts t -> Instruction (To t) -> Upwards t
    upwardsInstruction self fromAbove originalInstruction fromBelow transformedInstruction = foldlist ([(upwardsInfoFromInstructionData fromBelow)])
    -- ====================================================================================================
    --   == Node transformers for Assignment(current basetype: InstructionData)
    -- ====================================================================================================
    downwardsAssignmentInstructionInInstruction :: t -> Downwards t -> Assignment (From t) -> Downwards t
    downwardsAssignmentInstructionInInstruction self = const
    transformAssignmentInstructionInInstruction :: t -> Downwards t -> Assignment (From t) -> InfoFromAssignmentParts t -> InstructionData (To t)
    transformAssignmentInstructionInInstruction self fromAbove originalAssignment fromBelow = AssignmentInstruction $ originalAssignment {
        assignmentLhs = recursivelyTransformedAssignmentLhs fromBelow,
        assignmentRhs = recursivelyTransformedAssignmentRhs fromBelow,
        assignmentSemInf = convert $ assignmentSemInf originalAssignment
    }
    upwardsAssignmentInstructionInInstruction :: t -> Downwards t -> Assignment (From t) -> InfoFromAssignmentParts t -> InstructionData (To t) -> Upwards t
    upwardsAssignmentInstructionInInstruction self fromAbove originalAssignment fromBelow transformedAssignment = foldlist ([(upwardsInfoFromAssignmentLhs fromBelow)] ++ [(upwardsInfoFromAssignmentRhs fromBelow)])
    -- ====================================================================================================
    --   == Node transformers for ProcedureCall(current basetype: InstructionData)
    -- ====================================================================================================
    downwardsProcedureCallInstructionInInstruction :: t -> Downwards t -> ProcedureCall (From t) -> Downwards t
    downwardsProcedureCallInstructionInInstruction self = const
    transformProcedureCallInstructionInInstruction :: t -> Downwards t -> ProcedureCall (From t) -> InfoFromProcedureCallParts t -> InstructionData (To t)
    transformProcedureCallInstructionInInstruction self fromAbove originalProcedureCall fromBelow = ProcedureCallInstruction $ originalProcedureCall {
        actualParametersOfProcedureToCall = recursivelyTransformedActualParametersOfProcedureToCall fromBelow,
        procedureCallSemInf = convert $ procedureCallSemInf originalProcedureCall
    }
    upwardsProcedureCallInstructionInInstruction :: t -> Downwards t -> ProcedureCall (From t) -> InfoFromProcedureCallParts t -> InstructionData (To t) -> Upwards t
    upwardsProcedureCallInstructionInInstruction self fromAbove originalProcedureCall fromBelow transformedProcedureCall = foldlist ((upwardsInfoFromActualParametersOfProcedureToCall fromBelow))
    -- ====================================================================================================
    --   == Node transformers for ActualParameter
    -- ====================================================================================================
    downwardsActualParameter :: t -> Downwards t -> ActualParameter (From t) -> Downwards t
    downwardsActualParameter self = const
    transformActualParameter :: t -> Downwards t -> ActualParameter (From t) -> InfoFromActualParameterParts t -> ActualParameter (To t)
    transformActualParameter self fromAbove originalActualParameter fromBelow = originalActualParameter {
        actualParameterData = recursivelyTransformedActualParameterData fromBelow,
        actualParameterSemInf = convert $ actualParameterSemInf originalActualParameter
    }
    upwardsActualParameter :: t -> Downwards t -> ActualParameter (From t) -> InfoFromActualParameterParts t -> ActualParameter (To t) -> Upwards t
    upwardsActualParameter self fromAbove originalActualParameter fromBelow transformedActualParameter = foldlist ([(upwardsInfoFromActualParameterData fromBelow)])
    -- ====================================================================================================
    --   == Node transformers for Expression(current basetype: ActualParameterData)
    -- ====================================================================================================
    downwardsInputActualParameterInActualParameter :: t -> Downwards t -> Expression (From t) -> Downwards t
    downwardsInputActualParameterInActualParameter self = const
    transformInputActualParameterInActualParameter :: t -> Downwards t -> Expression (From t) -> InfoFromExpressionParts t -> ActualParameterData (To t)
    transformInputActualParameterInActualParameter self fromAbove originalExpression fromBelow = InputActualParameter $ originalExpression {
        expressionData = recursivelyTransformedExpressionData fromBelow,
        expressionSemInf = convert $ expressionSemInf originalExpression
    }
    upwardsInputActualParameterInActualParameter :: t -> Downwards t -> Expression (From t) -> InfoFromExpressionParts t -> ActualParameterData (To t) -> Upwards t
    upwardsInputActualParameterInActualParameter self fromAbove originalExpression fromBelow transformedExpression = foldlist ([(upwardsInfoFromExpressionData fromBelow)])
    -- ====================================================================================================
    --   == Node transformers for LeftValue(current basetype: ActualParameterData)
    -- ====================================================================================================
    downwardsOutputActualParameterInActualParameter :: t -> Downwards t -> LeftValue (From t) -> Downwards t
    downwardsOutputActualParameterInActualParameter self = const
    transformOutputActualParameterInActualParameter :: t -> Downwards t -> LeftValue (From t) -> InfoFromLeftValueParts t -> ActualParameterData (To t)
    transformOutputActualParameterInActualParameter self fromAbove originalLeftValue fromBelow = OutputActualParameter $ originalLeftValue {
        leftValueData = recursivelyTransformedLeftValueData fromBelow,
        leftValueSemInf = convert $ leftValueSemInf originalLeftValue
    }
    upwardsOutputActualParameterInActualParameter :: t -> Downwards t -> LeftValue (From t) -> InfoFromLeftValueParts t -> ActualParameterData (To t) -> Upwards t
    upwardsOutputActualParameterInActualParameter self fromAbove originalLeftValue fromBelow transformedLeftValue = foldlist ([(upwardsInfoFromLeftValueData fromBelow)])
    -- ====================================================================================================
    --   == Node transformers for IntConstantType
    -- ====================================================================================================
    transformIntConstant :: t -> Downwards t -> IntConstantType (From t) -> IntConstantType (To t)
    transformIntConstant self fromAbove originalIntConstantType = originalIntConstantType {
        intConstantSemInf = convert $ intConstantSemInf originalIntConstantType
    }
    upwardsIntConstant :: t -> Downwards t -> IntConstantType (From t) -> IntConstantType (To t) -> Upwards t
    upwardsIntConstant self fromAbove originalIntConstantType transformedIntConstantType = defaultValue
    -- ====================================================================================================
    --   == Node transformers for FloatConstantType
    -- ====================================================================================================
    transformFloatConstant :: t -> Downwards t -> FloatConstantType (From t) -> FloatConstantType (To t)
    transformFloatConstant self fromAbove originalFloatConstantType = originalFloatConstantType {
        floatConstantSemInf = convert $ floatConstantSemInf originalFloatConstantType
    }
    upwardsFloatConstant :: t -> Downwards t -> FloatConstantType (From t) -> FloatConstantType (To t) -> Upwards t
    upwardsFloatConstant self fromAbove originalFloatConstantType transformedFloatConstantType = defaultValue
    -- ====================================================================================================
    --   == Node transformers for BoolConstantType
    -- ====================================================================================================
    transformBoolConstant :: t -> Downwards t -> BoolConstantType (From t) -> BoolConstantType (To t)
    transformBoolConstant self fromAbove originalBoolConstantType = originalBoolConstantType {
        boolConstantSemInf = convert $ boolConstantSemInf originalBoolConstantType
    }
    upwardsBoolConstant :: t -> Downwards t -> BoolConstantType (From t) -> BoolConstantType (To t) -> Upwards t
    upwardsBoolConstant self fromAbove originalBoolConstantType transformedBoolConstantType = defaultValue
    -- ====================================================================================================
    --   == Node transformers for Variable
    -- ====================================================================================================
    transformVariable :: t -> Downwards t -> Variable (From t) -> Variable (To t)
    transformVariable self fromAbove originalVariable = originalVariable {
        variableSemInf = convert $ variableSemInf originalVariable
    }
    upwardsVariable :: t -> Downwards t -> Variable (From t) -> Variable (To t) -> Upwards t
    upwardsVariable self fromAbove originalVariable transformedVariable = defaultValue
-- ====================================================================================================
--   == Walker functions
-- ====================================================================================================
    -- ====================================================================================================
    --   == Walker for Procedure
    -- ====================================================================================================
    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 = InfoFromProcedureParts {
                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
    -- ====================================================================================================
    --   == Walker for Block
    -- ====================================================================================================
    walkBlock :: Walker t Block
    walkBlock selfpointer fromAbove construction = (transformedBlock, toAbove)
        where
            toBelow = downwardsBlock selfpointer fromAbove construction
            transformedBlockDeclarations = map (walkLocalDeclaration selfpointer toBelow) $ blockDeclarations construction
            transformedBlockInstructions = (walkProgram selfpointer toBelow) $ blockInstructions construction
            fromBelow = InfoFromBlockParts {
                recursivelyTransformedBlockDeclarations = map fst transformedBlockDeclarations,
                upwardsInfoFromBlockDeclarations = map snd transformedBlockDeclarations,
                recursivelyTransformedBlockInstructions = fst transformedBlockInstructions,
                upwardsInfoFromBlockInstructions = snd transformedBlockInstructions
            }
            transformedBlock = transformBlock selfpointer fromAbove construction fromBelow
            toAbove = upwardsBlock selfpointer fromAbove construction fromBelow transformedBlock
    -- ====================================================================================================
    --   == Walker for Program
    -- ====================================================================================================
    walkProgram :: Walker t Program
    walkProgram selfpointer fromAbove construction = (transformedProgram, toAbove)
        where
            toBelow = downwardsProgram selfpointer fromAbove construction
            transformedProgramConstruction = case programConstruction construction of
                EmptyProgram construction -> (walkEmptyProgramInProgram selfpointer toBelow) construction
                PrimitiveProgram construction -> (walkPrimitiveProgramInProgram selfpointer toBelow) construction
                SequenceProgram construction -> (walkSequenceProgramInProgram selfpointer toBelow) construction
                BranchProgram construction -> (walkBranchProgramInProgram selfpointer toBelow) construction
                SequentialLoopProgram construction -> (walkSequentialLoopProgramInProgram selfpointer toBelow) construction
                ParallelLoopProgram construction -> (walkParallelLoopProgramInProgram selfpointer toBelow) construction
            fromBelow = InfoFromProgramParts {
                recursivelyTransformedProgramConstruction = fst transformedProgramConstruction,
                upwardsInfoFromProgramConstruction = snd transformedProgramConstruction
            }
            transformedProgram = transformProgram selfpointer fromAbove construction fromBelow
            toAbove = upwardsProgram selfpointer fromAbove construction fromBelow transformedProgram
    -- ====================================================================================================
    --   == Walker for Empty, current base type: ProgramConstruction
    -- ====================================================================================================
    walkEmptyProgramInProgram :: (TransformationPhase t) => t -> Downwards t -> Empty (From t) -> (ProgramConstruction (To t), Upwards t)
    walkEmptyProgramInProgram selfpointer fromAbove construction = (transformedEmpty, toAbove)
        where
            transformedEmpty = transformEmptyProgramInProgram selfpointer fromAbove construction
            toAbove = upwardsEmptyProgramInProgram selfpointer fromAbove construction transformedEmpty
    -- ====================================================================================================
    --   == Walker for Primitive, current base type: ProgramConstruction
    -- ====================================================================================================
    walkPrimitiveProgramInProgram :: (TransformationPhase t) => t -> Downwards t -> Primitive (From t) -> (ProgramConstruction (To t), Upwards t)
    walkPrimitiveProgramInProgram selfpointer fromAbove construction = (transformedPrimitive, toAbove)
        where
            toBelow = downwardsPrimitiveProgramInProgram selfpointer fromAbove construction
            transformedPrimitiveInstruction = (walkInstruction selfpointer toBelow) $ primitiveInstruction construction
            fromBelow = InfoFromPrimitiveParts {
                recursivelyTransformedPrimitiveInstruction = fst transformedPrimitiveInstruction,
                upwardsInfoFromPrimitiveInstruction = snd transformedPrimitiveInstruction
            }
            transformedPrimitive = transformPrimitiveProgramInProgram selfpointer fromAbove construction fromBelow
            toAbove = upwardsPrimitiveProgramInProgram selfpointer fromAbove construction fromBelow transformedPrimitive
    -- ====================================================================================================
    --   == Walker for Sequence, current base type: ProgramConstruction
    -- ====================================================================================================
    walkSequenceProgramInProgram :: (TransformationPhase t) => t -> Downwards t -> Sequence (From t) -> (ProgramConstruction (To t), Upwards t)
    walkSequenceProgramInProgram selfpointer fromAbove construction = (transformedSequence, toAbove)
        where
            toBelow = downwardsSequenceProgramInProgram selfpointer fromAbove construction
            transformedSequenceProgramList = map (walkProgram selfpointer toBelow) $ sequenceProgramList construction
            fromBelow = InfoFromSequenceParts {
                recursivelyTransformedSequenceProgramList = map fst transformedSequenceProgramList,
                upwardsInfoFromSequenceProgramList = map snd transformedSequenceProgramList
            }
            transformedSequence = transformSequenceProgramInProgram selfpointer fromAbove construction fromBelow
            toAbove = upwardsSequenceProgramInProgram selfpointer fromAbove construction fromBelow transformedSequence
    -- ====================================================================================================
    --   == Walker for Branch, current base type: ProgramConstruction
    -- ====================================================================================================
    walkBranchProgramInProgram :: (TransformationPhase t) => t -> Downwards t -> Branch (From t) -> (ProgramConstruction (To t), Upwards t)
    walkBranchProgramInProgram selfpointer fromAbove construction = (transformedBranch, toAbove)
        where
            toBelow = downwardsBranchProgramInProgram selfpointer fromAbove construction
            transformedBranchConditionVariable = (walkVariable selfpointer toBelow) $ branchConditionVariable construction
            transformedThenBlock = (walkBlock selfpointer toBelow) $ thenBlock construction
            transformedElseBlock = (walkBlock selfpointer toBelow) $ elseBlock construction
            fromBelow = InfoFromBranchParts {
                recursivelyTransformedBranchConditionVariable = fst transformedBranchConditionVariable,
                upwardsInfoFromBranchConditionVariable = snd transformedBranchConditionVariable,
                recursivelyTransformedThenBlock = fst transformedThenBlock,
                upwardsInfoFromThenBlock = snd transformedThenBlock,
                recursivelyTransformedElseBlock = fst transformedElseBlock,
                upwardsInfoFromElseBlock = snd transformedElseBlock
            }
            transformedBranch = transformBranchProgramInProgram selfpointer fromAbove construction fromBelow
            toAbove = upwardsBranchProgramInProgram selfpointer fromAbove construction fromBelow transformedBranch
    -- ====================================================================================================
    --   == Walker for SequentialLoop, current base type: ProgramConstruction
    -- ====================================================================================================
    walkSequentialLoopProgramInProgram :: (TransformationPhase t) => t -> Downwards t -> SequentialLoop (From t) -> (ProgramConstruction (To t), Upwards t)
    walkSequentialLoopProgramInProgram selfpointer fromAbove construction = (transformedSequentialLoop, toAbove)
        where
            toBelow = downwardsSequentialLoopProgramInProgram selfpointer fromAbove construction
            transformedSequentialLoopCondition = (walkExpression selfpointer toBelow) $ sequentialLoopCondition construction
            transformedConditionCalculation = (walkBlock selfpointer toBelow) $ conditionCalculation construction
            transformedSequentialLoopCore = (walkBlock selfpointer toBelow) $ sequentialLoopCore construction
            fromBelow = InfoFromSequentialLoopParts {
                recursivelyTransformedSequentialLoopCondition = fst transformedSequentialLoopCondition,
                upwardsInfoFromSequentialLoopCondition = snd transformedSequentialLoopCondition,
                recursivelyTransformedConditionCalculation = fst transformedConditionCalculation,
                upwardsInfoFromConditionCalculation = snd transformedConditionCalculation,
                recursivelyTransformedSequentialLoopCore = fst transformedSequentialLoopCore,
                upwardsInfoFromSequentialLoopCore = snd transformedSequentialLoopCore
            }
            transformedSequentialLoop = transformSequentialLoopProgramInProgram selfpointer fromAbove construction fromBelow
            toAbove = upwardsSequentialLoopProgramInProgram selfpointer fromAbove construction fromBelow transformedSequentialLoop
    -- ====================================================================================================
    --   == Walker for ParallelLoop, current base type: ProgramConstruction
    -- ====================================================================================================
    walkParallelLoopProgramInProgram :: (TransformationPhase t) => t -> Downwards t -> ParallelLoop (From t) -> (ProgramConstruction (To t), Upwards t)
    walkParallelLoopProgramInProgram selfpointer fromAbove construction = (transformedParallelLoop, toAbove)
        where
            toBelow = downwardsParallelLoopProgramInProgram selfpointer fromAbove construction
            transformedParallelLoopConditionVariable = (walkVariable selfpointer toBelow) $ parallelLoopConditionVariable construction
            transformedNumberOfIterations = (walkExpression selfpointer toBelow) $ numberOfIterations construction
            transformedParallelLoopCore = (walkBlock selfpointer toBelow) $ parallelLoopCore construction
            fromBelow = InfoFromParallelLoopParts {
                recursivelyTransformedParallelLoopConditionVariable = fst transformedParallelLoopConditionVariable,
                upwardsInfoFromParallelLoopConditionVariable = snd transformedParallelLoopConditionVariable,
                recursivelyTransformedNumberOfIterations = fst transformedNumberOfIterations,
                upwardsInfoFromNumberOfIterations = snd transformedNumberOfIterations,
                recursivelyTransformedParallelLoopCore = fst transformedParallelLoopCore,
                upwardsInfoFromParallelLoopCore = snd transformedParallelLoopCore
            }
            transformedParallelLoop = transformParallelLoopProgramInProgram selfpointer fromAbove construction fromBelow
            toAbove = upwardsParallelLoopProgramInProgram selfpointer fromAbove construction fromBelow transformedParallelLoop
    -- ====================================================================================================
    --   == Walker for FormalParameter
    -- ====================================================================================================
    walkFormalParameter :: Walker t FormalParameter
    walkFormalParameter selfpointer fromAbove construction = (transformedFormalParameter, toAbove)
        where
            toBelow = downwardsFormalParameter selfpointer fromAbove construction
            transformedFormalParameterVariable = (walkVariable selfpointer toBelow) $ formalParameterVariable construction
            fromBelow = InfoFromFormalParameterParts {
                recursivelyTransformedFormalParameterVariable = fst transformedFormalParameterVariable,
                upwardsInfoFromFormalParameterVariable = snd transformedFormalParameterVariable
            }
            transformedFormalParameter = transformFormalParameter selfpointer fromAbove construction fromBelow
            toAbove = upwardsFormalParameter selfpointer fromAbove construction fromBelow transformedFormalParameter
    -- ====================================================================================================
    --   == Walker for LocalDeclaration
    -- ====================================================================================================
    walkLocalDeclaration :: Walker t LocalDeclaration
    walkLocalDeclaration selfpointer fromAbove construction = (transformedLocalDeclaration, toAbove)
        where
            toBelow = downwardsLocalDeclaration selfpointer fromAbove construction
            transformedLocalVariable = (walkVariable selfpointer toBelow) $ localVariable construction
            transformedLocalInitValue = case localInitValue construction of
                Nothing -> (Nothing, Nothing)
                Just justLocalInitValue -> (Just (fst transformedJustLocalInitValue), Just (snd transformedJustLocalInitValue))
                    where transformedJustLocalInitValue = (walkExpression selfpointer toBelow) $ justLocalInitValue
            fromBelow = InfoFromLocalDeclarationParts {
                recursivelyTransformedLocalVariable = fst transformedLocalVariable,
                upwardsInfoFromLocalVariable = snd transformedLocalVariable,
                recursivelyTransformedLocalInitValue = fst transformedLocalInitValue,
                upwardsInfoFromLocalInitValue = snd transformedLocalInitValue
            }
            transformedLocalDeclaration = transformLocalDeclaration selfpointer fromAbove construction fromBelow
            toAbove = upwardsLocalDeclaration selfpointer fromAbove construction fromBelow transformedLocalDeclaration
    -- ====================================================================================================
    --   == Walker for Expression
    -- ====================================================================================================
    walkExpression :: Walker t Expression
    walkExpression selfpointer fromAbove construction = (transformedExpression, toAbove)
        where
            toBelow = downwardsExpression selfpointer fromAbove construction
            transformedExpressionData = case expressionData construction of
                LeftValueExpression construction -> (walkLeftValueExpressionInExpression selfpointer toBelow) construction
                ConstantExpression construction -> (walkConstantExpressionInExpression selfpointer toBelow) construction
                FunctionCallExpression construction -> (walkFunctionCallExpressionInExpression selfpointer toBelow) construction
            fromBelow = InfoFromExpressionParts {
                recursivelyTransformedExpressionData = fst transformedExpressionData,
                upwardsInfoFromExpressionData = snd transformedExpressionData
            }
            transformedExpression = transformExpression selfpointer fromAbove construction fromBelow
            toAbove = upwardsExpression selfpointer fromAbove construction fromBelow transformedExpression
    -- ====================================================================================================
    --   == Walker for LeftValue, current base type: ExpressionData
    -- ====================================================================================================
    walkLeftValueExpressionInExpression :: (TransformationPhase t) => t -> Downwards t -> LeftValue (From t) -> (ExpressionData (To t), Upwards t)
    walkLeftValueExpressionInExpression selfpointer fromAbove construction = (transformedLeftValue, toAbove)
        where
            toBelow = downwardsLeftValueExpressionInExpression selfpointer fromAbove construction
            transformedLeftValueData = case leftValueData construction of
                VariableLeftValue construction -> (walkVariableLeftValueInLeftValue selfpointer toBelow) construction
                ArrayElemReferenceLeftValue construction -> (walkArrayElemReferenceLeftValueInLeftValue selfpointer toBelow) construction
            fromBelow = InfoFromLeftValueParts {
                recursivelyTransformedLeftValueData = fst transformedLeftValueData,
                upwardsInfoFromLeftValueData = snd transformedLeftValueData
            }
            transformedLeftValue = transformLeftValueExpressionInExpression selfpointer fromAbove construction fromBelow
            toAbove = upwardsLeftValueExpressionInExpression selfpointer fromAbove construction fromBelow transformedLeftValue
    -- ====================================================================================================
    --   == Walker for Constant, current base type: ExpressionData
    -- ====================================================================================================
    walkConstantExpressionInExpression :: (TransformationPhase t) => t -> Downwards t -> Constant (From t) -> (ExpressionData (To t), Upwards t)
    walkConstantExpressionInExpression selfpointer fromAbove construction = (transformedConstant, toAbove)
        where
            toBelow = downwardsConstantExpressionInExpression selfpointer fromAbove construction
            transformedConstantData = case constantData construction of
                IntConstant construction -> (walkIntConstantInConstant selfpointer toBelow) construction
                FloatConstant construction -> (walkFloatConstantInConstant selfpointer toBelow) construction
                BoolConstant construction -> (walkBoolConstantInConstant selfpointer toBelow) construction
                ArrayConstant construction -> (walkArrayConstantInConstant selfpointer toBelow) construction
            fromBelow = InfoFromConstantParts {
                recursivelyTransformedConstantData = fst transformedConstantData,
                upwardsInfoFromConstantData = snd transformedConstantData
            }
            transformedConstant = transformConstantExpressionInExpression selfpointer fromAbove construction fromBelow
            toAbove = upwardsConstantExpressionInExpression selfpointer fromAbove construction fromBelow transformedConstant
    -- ====================================================================================================
    --   == Walker for FunctionCall, current base type: ExpressionData
    -- ====================================================================================================
    walkFunctionCallExpressionInExpression :: (TransformationPhase t) => t -> Downwards t -> FunctionCall (From t) -> (ExpressionData (To t), Upwards t)
    walkFunctionCallExpressionInExpression selfpointer fromAbove construction = (transformedFunctionCall, toAbove)
        where
            toBelow = downwardsFunctionCallExpressionInExpression selfpointer fromAbove construction
            transformedActualParametersOfFunctionToCall = map (walkExpression selfpointer toBelow) $ actualParametersOfFunctionToCall construction
            fromBelow = InfoFromFunctionCallParts {
                recursivelyTransformedActualParametersOfFunctionToCall = map fst transformedActualParametersOfFunctionToCall,
                upwardsInfoFromActualParametersOfFunctionToCall = map snd transformedActualParametersOfFunctionToCall
            }
            transformedFunctionCall = transformFunctionCallExpressionInExpression selfpointer fromAbove construction fromBelow
            toAbove = upwardsFunctionCallExpressionInExpression selfpointer fromAbove construction fromBelow transformedFunctionCall
    -- ====================================================================================================
    --   == Walker for Constant
    -- ====================================================================================================
    walkConstant :: Walker t Constant
    walkConstant selfpointer fromAbove construction = (transformedConstant, toAbove)
        where
            toBelow = downwardsConstant selfpointer fromAbove construction
            transformedConstantData = case constantData construction of
                IntConstant construction -> (walkIntConstantInConstant selfpointer toBelow) construction
                FloatConstant construction -> (walkFloatConstantInConstant selfpointer toBelow) construction
                BoolConstant construction -> (walkBoolConstantInConstant selfpointer toBelow) construction
                ArrayConstant construction -> (walkArrayConstantInConstant selfpointer toBelow) construction
            fromBelow = InfoFromConstantParts {
                recursivelyTransformedConstantData = fst transformedConstantData,
                upwardsInfoFromConstantData = snd transformedConstantData
            }
            transformedConstant = transformConstant selfpointer fromAbove construction fromBelow
            toAbove = upwardsConstant selfpointer fromAbove construction fromBelow transformedConstant
    -- ====================================================================================================
    --   == Walker for IntConstantType, current base type: ConstantData
    -- ====================================================================================================
    walkIntConstantInConstant :: (TransformationPhase t) => t -> Downwards t -> IntConstantType (From t) -> (ConstantData (To t), Upwards t)
    walkIntConstantInConstant selfpointer fromAbove construction = (transformedIntConstantType, toAbove)
        where
            transformedIntConstantType = transformIntConstantInConstant selfpointer fromAbove construction
            toAbove = upwardsIntConstantInConstant selfpointer fromAbove construction transformedIntConstantType
    -- ====================================================================================================
    --   == Walker for FloatConstantType, current base type: ConstantData
    -- ====================================================================================================
    walkFloatConstantInConstant :: (TransformationPhase t) => t -> Downwards t -> FloatConstantType (From t) -> (ConstantData (To t), Upwards t)
    walkFloatConstantInConstant selfpointer fromAbove construction = (transformedFloatConstantType, toAbove)
        where
            transformedFloatConstantType = transformFloatConstantInConstant selfpointer fromAbove construction
            toAbove = upwardsFloatConstantInConstant selfpointer fromAbove construction transformedFloatConstantType
    -- ====================================================================================================
    --   == Walker for BoolConstantType, current base type: ConstantData
    -- ====================================================================================================
    walkBoolConstantInConstant :: (TransformationPhase t) => t -> Downwards t -> BoolConstantType (From t) -> (ConstantData (To t), Upwards t)
    walkBoolConstantInConstant selfpointer fromAbove construction = (transformedBoolConstantType, toAbove)
        where
            transformedBoolConstantType = transformBoolConstantInConstant selfpointer fromAbove construction
            toAbove = upwardsBoolConstantInConstant selfpointer fromAbove construction transformedBoolConstantType
    -- ====================================================================================================
    --   == Walker for ArrayConstantType, current base type: ConstantData
    -- ====================================================================================================
    walkArrayConstantInConstant :: (TransformationPhase t) => t -> Downwards t -> ArrayConstantType (From t) -> (ConstantData (To t), Upwards t)
    walkArrayConstantInConstant selfpointer fromAbove construction = (transformedArrayConstantType, toAbove)
        where
            toBelow = downwardsArrayConstantInConstant selfpointer fromAbove construction
            transformedArrayConstantValue = map (walkConstant selfpointer toBelow) $ arrayConstantValue construction
            fromBelow = InfoFromArrayConstantParts {
                recursivelyTransformedArrayConstantValue = map fst transformedArrayConstantValue,
                upwardsInfoFromArrayConstantValue = map snd transformedArrayConstantValue
            }
            transformedArrayConstantType = transformArrayConstantInConstant selfpointer fromAbove construction fromBelow
            toAbove = upwardsArrayConstantInConstant selfpointer fromAbove construction fromBelow transformedArrayConstantType

    -- ====================================================================================================
    --   == Walker for LeftValue
    -- ====================================================================================================
    walkLeftValue :: Walker t LeftValue
    walkLeftValue selfpointer fromAbove construction = (transformedLeftValue, toAbove)
        where
            toBelow = downwardsLeftValue selfpointer fromAbove construction
            transformedLeftValueData = case leftValueData construction of
                VariableLeftValue construction -> (walkVariableLeftValueInLeftValue selfpointer toBelow) construction
                ArrayElemReferenceLeftValue construction -> (walkArrayElemReferenceLeftValueInLeftValue selfpointer toBelow) construction
            fromBelow = InfoFromLeftValueParts {
                recursivelyTransformedLeftValueData = fst transformedLeftValueData,
                upwardsInfoFromLeftValueData = snd transformedLeftValueData
            }
            transformedLeftValue = transformLeftValue selfpointer fromAbove construction fromBelow
            toAbove = upwardsLeftValue selfpointer fromAbove construction fromBelow transformedLeftValue
    -- ====================================================================================================
    --   == Walker for Variable, current base type: LeftValueData
    -- ====================================================================================================
    walkVariableLeftValueInLeftValue :: (TransformationPhase t) => t -> Downwards t -> Variable (From t) -> (LeftValueData (To t), Upwards t)
    walkVariableLeftValueInLeftValue selfpointer fromAbove construction = (transformedVariable, toAbove)
        where
            transformedVariable = transformVariableLeftValueInLeftValue selfpointer fromAbove construction
            toAbove = upwardsVariableLeftValueInLeftValue selfpointer fromAbove construction transformedVariable
    -- ====================================================================================================
    --   == Walker for ArrayElemReference, current base type: LeftValueData
    -- ====================================================================================================
    walkArrayElemReferenceLeftValueInLeftValue :: (TransformationPhase t) => t -> Downwards t -> ArrayElemReference (From t) -> (LeftValueData (To t), Upwards t)
    walkArrayElemReferenceLeftValueInLeftValue selfpointer fromAbove construction = (transformedArrayElemReference, toAbove)
        where
            toBelow = downwardsArrayElemReferenceLeftValueInLeftValue selfpointer fromAbove construction
            transformedArrayName = (walkLeftValue selfpointer toBelow) $ arrayName construction
            transformedArrayIndex = (walkExpression selfpointer toBelow) $ arrayIndex construction
            fromBelow = InfoFromArrayElemReferenceParts {
                recursivelyTransformedArrayName = fst transformedArrayName,
                upwardsInfoFromArrayName = snd transformedArrayName,
                recursivelyTransformedArrayIndex = fst transformedArrayIndex,
                upwardsInfoFromArrayIndex = snd transformedArrayIndex
            }
            transformedArrayElemReference = transformArrayElemReferenceLeftValueInLeftValue selfpointer fromAbove construction fromBelow
            toAbove = upwardsArrayElemReferenceLeftValueInLeftValue selfpointer fromAbove construction fromBelow transformedArrayElemReference
    -- ====================================================================================================
    --   == Walker for Instruction
    -- ====================================================================================================
    walkInstruction :: Walker t Instruction
    walkInstruction selfpointer fromAbove construction = (transformedInstruction, toAbove)
        where
            toBelow = downwardsInstruction selfpointer fromAbove construction
            transformedInstructionData = case instructionData construction of
                AssignmentInstruction construction -> (walkAssignmentInstructionInInstruction selfpointer toBelow) construction
                ProcedureCallInstruction construction -> (walkProcedureCallInstructionInInstruction selfpointer toBelow) construction
            fromBelow = InfoFromInstructionParts {
                recursivelyTransformedInstructionData = fst transformedInstructionData,
                upwardsInfoFromInstructionData = snd transformedInstructionData
            }
            transformedInstruction = transformInstruction selfpointer fromAbove construction fromBelow
            toAbove = upwardsInstruction selfpointer fromAbove construction fromBelow transformedInstruction
    -- ====================================================================================================
    --   == Walker for Assignment, current base type: InstructionData
    -- ====================================================================================================
    walkAssignmentInstructionInInstruction :: (TransformationPhase t) => t -> Downwards t -> Assignment (From t) -> (InstructionData (To t), Upwards t)
    walkAssignmentInstructionInInstruction selfpointer fromAbove construction = (transformedAssignment, toAbove)
        where
            toBelow = downwardsAssignmentInstructionInInstruction selfpointer fromAbove construction
            transformedAssignmentLhs = (walkLeftValue selfpointer toBelow) $ assignmentLhs construction
            transformedAssignmentRhs = (walkExpression selfpointer toBelow) $ assignmentRhs construction
            fromBelow = InfoFromAssignmentParts {
                recursivelyTransformedAssignmentLhs = fst transformedAssignmentLhs,
                upwardsInfoFromAssignmentLhs = snd transformedAssignmentLhs,
                recursivelyTransformedAssignmentRhs = fst transformedAssignmentRhs,
                upwardsInfoFromAssignmentRhs = snd transformedAssignmentRhs
            }
            transformedAssignment = transformAssignmentInstructionInInstruction selfpointer fromAbove construction fromBelow
            toAbove = upwardsAssignmentInstructionInInstruction selfpointer fromAbove construction fromBelow transformedAssignment
    -- ====================================================================================================
    --   == Walker for ProcedureCall, current base type: InstructionData
    -- ====================================================================================================
    walkProcedureCallInstructionInInstruction :: (TransformationPhase t) => t -> Downwards t -> ProcedureCall (From t) -> (InstructionData (To t), Upwards t)
    walkProcedureCallInstructionInInstruction selfpointer fromAbove construction = (transformedProcedureCall, toAbove)
        where
            toBelow = downwardsProcedureCallInstructionInInstruction selfpointer fromAbove construction
            transformedActualParametersOfProcedureToCall = map (walkActualParameter selfpointer toBelow) $ actualParametersOfProcedureToCall construction
            fromBelow = InfoFromProcedureCallParts {
                recursivelyTransformedActualParametersOfProcedureToCall = map fst transformedActualParametersOfProcedureToCall,
                upwardsInfoFromActualParametersOfProcedureToCall = map snd transformedActualParametersOfProcedureToCall
            }
            transformedProcedureCall = transformProcedureCallInstructionInInstruction selfpointer fromAbove construction fromBelow
            toAbove = upwardsProcedureCallInstructionInInstruction selfpointer fromAbove construction fromBelow transformedProcedureCall
    -- ====================================================================================================
    --   == Walker for ActualParameter
    -- ====================================================================================================
    walkActualParameter :: Walker t ActualParameter
    walkActualParameter selfpointer fromAbove construction = (transformedActualParameter, toAbove)
        where
            toBelow = downwardsActualParameter selfpointer fromAbove construction
            transformedActualParameterData = case actualParameterData construction of
                InputActualParameter construction -> (walkInputActualParameterInActualParameter selfpointer toBelow) construction
                OutputActualParameter construction -> (walkOutputActualParameterInActualParameter selfpointer toBelow) construction
            fromBelow = InfoFromActualParameterParts {
                recursivelyTransformedActualParameterData = fst transformedActualParameterData,
                upwardsInfoFromActualParameterData = snd transformedActualParameterData
            }
            transformedActualParameter = transformActualParameter selfpointer fromAbove construction fromBelow
            toAbove = upwardsActualParameter selfpointer fromAbove construction fromBelow transformedActualParameter
    -- ====================================================================================================
    --   == Walker for Expression, current base type: ActualParameterData
    -- ====================================================================================================
    walkInputActualParameterInActualParameter :: (TransformationPhase t) => t -> Downwards t -> Expression (From t) -> (ActualParameterData (To t), Upwards t)
    walkInputActualParameterInActualParameter selfpointer fromAbove construction = (transformedExpression, toAbove)
        where
            toBelow = downwardsInputActualParameterInActualParameter selfpointer fromAbove construction
            transformedExpressionData = case expressionData construction of
                LeftValueExpression construction -> (walkLeftValueExpressionInExpression selfpointer toBelow) construction
                ConstantExpression construction -> (walkConstantExpressionInExpression selfpointer toBelow) construction
                FunctionCallExpression construction -> (walkFunctionCallExpressionInExpression selfpointer toBelow) construction
            fromBelow = InfoFromExpressionParts {
                recursivelyTransformedExpressionData = fst transformedExpressionData,
                upwardsInfoFromExpressionData = snd transformedExpressionData
            }
            transformedExpression = transformInputActualParameterInActualParameter selfpointer fromAbove construction fromBelow
            toAbove = upwardsInputActualParameterInActualParameter selfpointer fromAbove construction fromBelow transformedExpression
    -- ====================================================================================================
    --   == Walker for LeftValue, current base type: ActualParameterData
    -- ====================================================================================================
    walkOutputActualParameterInActualParameter :: (TransformationPhase t) => t -> Downwards t -> LeftValue (From t) -> (ActualParameterData (To t), Upwards t)
    walkOutputActualParameterInActualParameter selfpointer fromAbove construction = (transformedLeftValue, toAbove)
        where
            toBelow = downwardsOutputActualParameterInActualParameter selfpointer fromAbove construction
            transformedLeftValueData = case leftValueData construction of
                VariableLeftValue construction -> (walkVariableLeftValueInLeftValue selfpointer toBelow) construction
                ArrayElemReferenceLeftValue construction -> (walkArrayElemReferenceLeftValueInLeftValue selfpointer toBelow) construction
            fromBelow = InfoFromLeftValueParts {
                recursivelyTransformedLeftValueData = fst transformedLeftValueData,
                upwardsInfoFromLeftValueData = snd transformedLeftValueData
            }
            transformedLeftValue = transformOutputActualParameterInActualParameter selfpointer fromAbove construction fromBelow
            toAbove = upwardsOutputActualParameterInActualParameter selfpointer fromAbove construction fromBelow transformedLeftValue
    -- ====================================================================================================
    --   == Walker for Variable
    -- ====================================================================================================
    walkVariable :: Walker t Variable
    walkVariable selfpointer fromAbove construction = (transformedVariable, toAbove)
        where
            transformedVariable = transformVariable selfpointer fromAbove construction
            toAbove = upwardsVariable selfpointer fromAbove construction transformedVariable
-- ====================================================================================================
--   == Upwards types
-- ====================================================================================================
data (TransformationPhase t) => InfoFromProcedureParts t = InfoFromProcedureParts {
    recursivelyTransformedInParameters                           :: [FormalParameter (To t)],
    upwardsInfoFromInParameters                                  :: [Upwards t],
    recursivelyTransformedOutParameters                          :: [FormalParameter (To t)],
    upwardsInfoFromOutParameters                                 :: [Upwards t],
    recursivelyTransformedProcedureBody                          :: Block (To t),
    upwardsInfoFromProcedureBody                                 :: Upwards t
}
data (TransformationPhase t) => InfoFromBlockParts t = InfoFromBlockParts {
    recursivelyTransformedBlockDeclarations                      :: [LocalDeclaration (To t)],
    upwardsInfoFromBlockDeclarations                             :: [Upwards t],
    recursivelyTransformedBlockInstructions                      :: Program (To t),
    upwardsInfoFromBlockInstructions                             :: Upwards t
}
data (TransformationPhase t) => InfoFromProgramParts t = InfoFromProgramParts {
    recursivelyTransformedProgramConstruction                    :: ProgramConstruction (To t),
    upwardsInfoFromProgramConstruction                           :: Upwards t
}
data (TransformationPhase t) => InfoFromPrimitiveParts t = InfoFromPrimitiveParts {
    recursivelyTransformedPrimitiveInstruction                   :: Instruction (To t),
    upwardsInfoFromPrimitiveInstruction                          :: Upwards t
}
data (TransformationPhase t) => InfoFromSequenceParts t = InfoFromSequenceParts {
    recursivelyTransformedSequenceProgramList                    :: [Program (To t)],
    upwardsInfoFromSequenceProgramList                           :: [Upwards t]
}
data (TransformationPhase t) => InfoFromBranchParts t = InfoFromBranchParts {
    recursivelyTransformedBranchConditionVariable                :: Variable (To t),
    upwardsInfoFromBranchConditionVariable                       :: Upwards t,
    recursivelyTransformedThenBlock                              :: Block (To t),
    upwardsInfoFromThenBlock                                     :: Upwards t,
    recursivelyTransformedElseBlock                              :: Block (To t),
    upwardsInfoFromElseBlock                                     :: Upwards t
}
data (TransformationPhase t) => InfoFromSequentialLoopParts t = InfoFromSequentialLoopParts {
    recursivelyTransformedSequentialLoopCondition                :: Expression (To t),
    upwardsInfoFromSequentialLoopCondition                       :: Upwards t,
    recursivelyTransformedConditionCalculation                   :: Block (To t),
    upwardsInfoFromConditionCalculation                          :: Upwards t,
    recursivelyTransformedSequentialLoopCore                     :: Block (To t),
    upwardsInfoFromSequentialLoopCore                            :: Upwards t
}
data (TransformationPhase t) => InfoFromParallelLoopParts t = InfoFromParallelLoopParts {
    recursivelyTransformedParallelLoopConditionVariable          :: Variable (To t),
    upwardsInfoFromParallelLoopConditionVariable                 :: Upwards t,
    recursivelyTransformedNumberOfIterations                     :: Expression (To t),
    upwardsInfoFromNumberOfIterations                            :: Upwards t,
    recursivelyTransformedParallelLoopCore                       :: Block (To t),
    upwardsInfoFromParallelLoopCore                              :: Upwards t
}
data (TransformationPhase t) => InfoFromFormalParameterParts t = InfoFromFormalParameterParts {
    recursivelyTransformedFormalParameterVariable                :: Variable (To t),
    upwardsInfoFromFormalParameterVariable                       :: Upwards t
}
data (TransformationPhase t) => InfoFromLocalDeclarationParts t = InfoFromLocalDeclarationParts {
    recursivelyTransformedLocalVariable                          :: Variable (To t),
    upwardsInfoFromLocalVariable                                 :: Upwards t,
    recursivelyTransformedLocalInitValue                         :: Maybe (Expression (To t)),
    upwardsInfoFromLocalInitValue                                :: Maybe (Upwards t)
}
data (TransformationPhase t) => InfoFromExpressionParts t = InfoFromExpressionParts {
    recursivelyTransformedExpressionData                         :: ExpressionData (To t),
    upwardsInfoFromExpressionData                                :: Upwards t
}
data (TransformationPhase t) => InfoFromConstantParts t = InfoFromConstantParts {
    recursivelyTransformedConstantData                           :: ConstantData (To t),
    upwardsInfoFromConstantData                                  :: Upwards t
}
data (TransformationPhase t) => InfoFromFunctionCallParts t = InfoFromFunctionCallParts {
    recursivelyTransformedActualParametersOfFunctionToCall       :: [Expression (To t)],
    upwardsInfoFromActualParametersOfFunctionToCall              :: [Upwards t]
}
data (TransformationPhase t) => InfoFromLeftValueParts t = InfoFromLeftValueParts {
    recursivelyTransformedLeftValueData                          :: LeftValueData (To t),
    upwardsInfoFromLeftValueData                                 :: Upwards t
}
data (TransformationPhase t) => InfoFromArrayElemReferenceParts t = InfoFromArrayElemReferenceParts {
    recursivelyTransformedArrayName                              :: LeftValue (To t),
    upwardsInfoFromArrayName                                     :: Upwards t,
    recursivelyTransformedArrayIndex                             :: Expression (To t),
    upwardsInfoFromArrayIndex                                    :: Upwards t
}
data (TransformationPhase t) => InfoFromInstructionParts t = InfoFromInstructionParts {
    recursivelyTransformedInstructionData                        :: InstructionData (To t),
    upwardsInfoFromInstructionData                               :: Upwards t
}
data (TransformationPhase t) => InfoFromAssignmentParts t = InfoFromAssignmentParts {
    recursivelyTransformedAssignmentLhs                          :: LeftValue (To t),
    upwardsInfoFromAssignmentLhs                                 :: Upwards t,
    recursivelyTransformedAssignmentRhs                          :: Expression (To t),
    upwardsInfoFromAssignmentRhs                                 :: Upwards t
}
data (TransformationPhase t) => InfoFromProcedureCallParts t = InfoFromProcedureCallParts {
    recursivelyTransformedActualParametersOfProcedureToCall      :: [ActualParameter (To t)],
    upwardsInfoFromActualParametersOfProcedureToCall             :: [Upwards t]
}
data (TransformationPhase t) => InfoFromActualParameterParts t = InfoFromActualParameterParts {
    recursivelyTransformedActualParameterData                    :: ActualParameterData (To t),
    upwardsInfoFromActualParameterData                           :: Upwards t
}
data (TransformationPhase t) => InfoFromArrayConstantParts t = InfoFromArrayConstantParts {
    recursivelyTransformedArrayConstantValue                     :: [Constant (To t)],
    upwardsInfoFromArrayConstantValue                            :: [Upwards t]
}