--
-- 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 FlexibleInstances #-}

module Feldspar.Compiler.Transformation.GraphToImperative where

import Feldspar.Core.Graph
import Feldspar.Range
import qualified Feldspar.Core.Graph as Graph
import Feldspar.Core.Types hiding (typeOf)
import qualified Feldspar.Core.Types as CoreTypes
import Feldspar.Compiler.Imperative.Representation
import Feldspar.Compiler.Imperative.CodeGeneration
import qualified Feldspar.Compiler.Imperative.Representation as Representation
import Feldspar.Compiler.Transformation.GraphUtils
import Data.List
import qualified Data.Map as Map
import qualified Data.Maybe as Maybe
import Feldspar.Compiler.Error
import Feldspar.Compiler.Imperative.Semantics

-- Transforms a hierarchical graph to a list of imperative functions.
    -- collect sources for each function
    -- compile each of them
    -- put the results in a list
graphToImperative :: HierarchicalGraph -> [Procedure InitSemInf]
graphToImperative g = map transformSourceToProcedure sources where
        sources = this : collectSources g
        this    = ProcedureSource
                { interface         = hierGraphInterface g
                , hierarchy         = graphHierarchy g
                }

-- A datastructure to represent all data needed for transformation to an
-- imperative function.
data ProcedureSource
    = ProcedureSource
    { interface       :: Interface
    , hierarchy       :: Hierarchy
    }

-- 'collectSources' walks thorugh the graph and collects the interfaces
-- and hierarchies of 'NoInline' nodes.
class Collect t where
    collectSources :: t -> [ProcedureSource]

instance Collect HierarchicalGraph where
    collectSources g    = collectSources $ graphHierarchy g

instance Collect Hierarchy where
    collectSources (Hierarchy xs)   = collectSources xs

instance (Collect t) => Collect [t] where
    collectSources xs   = concatMap collectSources xs

instance Collect (Node,[Hierarchy]) where
    collectSources (n,hs) = this ++ collectSources hs where
        this = case function n of
            NoInline name interface -> case hs of
                [hierarchy] -> [ProcedureSource interface hierarchy]
                _           -> error $ "Graph error: malformed hierarchy list in the 'NoInline' node with id " ++ show (nodeId n)
            _ -> []

-- Transforms an interface and a hierarchy to an imperative function.
    -- transform top level nodes to declarations
    -- split the declarations into 'input' and 'local' groups
    -- generate output parameters
    -- transform each top-level node to a Program
transformSourceToProcedure :: ProcedureSource -> Procedure InitSemInf
transformSourceToProcedure (ProcedureSource ifc (Hierarchy pairs))
  = Procedure {
        procedureName = "PLACEHOLDER",
        inParameters  = inputDecls,
        outParameters = outputDecls,
        procedureBody = Block {
            blockDeclarations = localDecls,
            blockInstructions = Program {
                                    programConstruction = SequenceProgram $ Sequence {
                                        sequenceProgramList = ( map transformNodeToProgram pairs
                                                               ++ copyToOutput (interfaceOutput ifc) (interfaceOutputType ifc) True ),
                                        sequenceSemInf = ()
                                    },
                                    programSemInf = ()
                                },
            blockSemInf = ()
        },
        procedureSemInf = ()
    } where
        inputDecls = case inputNodes of
                            [inputNode] -> transformNodeToFormalParameter inputNode
                            [] -> handleError "GraphToImperative" InvariantViolation $ "no input node found" ++ (show (map fst pairs))
                            _  -> handleError "GraphToImperative" InvariantViolation $ "exactly one input node expected; nodeId==" ++ (show $ nodeId $ head inputNodes)
        localDecls = concatMap transformNodeToLocalDeclaration localNodes
        outputDecls = tupleWalk transformSourceToFormalParameter $ interfaceOutputType ifc
        transformSourceToFormalParameter :: [Int] -> StorableType -> FormalParameter InitSemInf
        transformSourceToFormalParameter path typ = FormalParameter {
            formalParameterVariable = Representation.Variable FunOut ctyp (outName path) (),
            formalParameterSemInf = ()
        } where
             ctyp = compileStorableType typ
        (inputNodes,localNodes) = partition (\n -> nodeId n == interfaceInput ifc) $ map fst pairs

-- Transforms a node to declarations. The number of generated declarations is
-- determined by the tuple leafs of the tuple structure in the node type.
    -- walk through the tuple structure in the node type
    -- variable name: "var" ++ 'node id' ++ 'path in the tuple structure'
    -- variable type: type of the leaf in the structure
transformNodeToFormalParameter :: Node -> [FormalParameter InitSemInf]
transformNodeToFormalParameter n = tupleWalk genDecl $ tupleZip (outTyps,initVals) where
    genDecl path (typ,ini)
        = FormalParameter {
              formalParameterVariable = Representation.Variable Value ctyp (varPrefix (nodeId n) ++ varPath path) (),
              formalParameterSemInf = ()
          } where
              ctyp = compileStorableType typ
    outTyps = outputType n
    initVals = case function n of
        Array d     -> case outTyps of
            One t -> One $ Just $ compileStorableData d t
            _       -> error "Error: malformed output type of array node."
        otherwise   -> genNothingTuple outTyps
    genNothingTuple (One _) = One Nothing
    genNothingTuple (Tup xs) = Tup $ map genNothingTuple xs

transformNodeToLocalDeclaration :: Node -> [LocalDeclaration InitSemInf]
transformNodeToLocalDeclaration n = tupleWalk genDecl $ tupleZip (outTyps,initVals) where
    genDecl path (typ,ini) = LocalDeclaration {
        localVariable     = Representation.Variable {
            variableRole = Value,
            variableType = ctyp,
            variableName = (varPrefix (nodeId n) ++ varPath path),
            variableSemInf = ()
        },
        localInitValue = ini,
        localDeclarationSemInf  = ()
    } where
        ctyp = compileStorableType typ
    outTyps = outputType n
    initVals = case function n of
        Array d     -> case outTyps of
            One t -> One $ Just $ compileStorableData d t
            _       -> error "Error: malformed output type of array node."
        otherwise   -> genNothingTuple outTyps
    genNothingTuple (One _) = One Nothing
    genNothingTuple (Tup xs) = Tup $ map genNothingTuple xs

transformNodeListToFormalParameters :: [Node] -> [FormalParameter InitSemInf]
transformNodeListToFormalParameters ns = concatMap transformNodeToFormalParameter ns

transformNodeListToLocalDeclarations :: [Node] -> [LocalDeclaration InitSemInf]
transformNodeListToLocalDeclarations ns = concatMap transformNodeToLocalDeclaration ns

-- Transforms a node and its subgraphs (if any) to an imperative program.
transformNodeToProgram :: (Node, [Hierarchy]) -> Program InitSemInf
transformNodeToProgram (n,hs) = case function n of
    Graph.Input     -> Program (EmptyProgram $ Empty ()) ()
    Array _         -> Program (EmptyProgram $ Empty ()) ()
    Function s      -> Program {
                            programConstruction = PrimitiveProgram $ Primitive {
                                primitiveInstruction = Instruction {
                                                           instructionData = (ProcedureCallInstruction $ ProcedureCall {
                                                               nameOfProcedureToCall = s,
                                                               actualParametersOfProcedureToCall = passInArgs (input n) (inputType n) ++
                                                                                                   passOutArgs (nodeId n) (outputType n),
                                                               procedureCallSemInf = ()
                                                           }),
                                                           instructionSemInf = ()
                                                       },
                                primitiveSemInf = False
                           },
                           programSemInf = ()
                       }
    -- non-inlined function node:
        -- call the non-inlined function
        -- actual arguments come from the node input and the node id
    NoInline s ifc  -> Program {
                            programConstruction = PrimitiveProgram $ Primitive {
                                primitiveInstruction = Instruction {
                                                           instructionData = (ProcedureCallInstruction $ ProcedureCall {
                                                               nameOfProcedureToCall = s,
                                                               actualParametersOfProcedureToCall = passInArgs  (input n) (inputType n) ++
                                                                                                   passOutArgs (nodeId n) (outputType n),
                                                               procedureCallSemInf = ()
                                                           }),
                                                           instructionSemInf = ()
                                                       },
                                primitiveSemInf = False
                            },
                            programSemInf = ()
                       }
    -- conditional node:
        -- condition: first element of the input tuple
        -- then branch: compiled from the first interface and the first hierarchy
        -- else branch: compiled from the second interface and the second hierarchy
    Graph.IfThenElse thenIfc elseIfc -> case hs of
        [thenH, elseH] -> case (input n, inputType n) of
            (Tup [cond, inp], Tup [One condTyp, inTyp])
                | interfaceInputType thenIfc /= inTyp || interfaceInputType elseIfc /= inTyp
                    -> error "Error in 'ifThenElse' node: incorrect interface input type."
                | compileStorableType condTyp /= Feldspar.Compiler.Imperative.Representation.BoolType
                    -> error "Error in 'ifThenElse' node: node output is expected to be 'Bool'."
                | otherwise -> Program {
                      programConstruction = BranchProgram $ Branch {
                          branchConditionVariable = condVar,
                          thenBlock               = mkBranch n thenIfc thenH,
                          elseBlock               = mkBranch n elseIfc elseH,
                          branchSemInf            = ()
                      },
                      programSemInf = ()
                  }
                        where
                            mkBranch :: Node -> Interface -> Hierarchy -> Block InitSemInf
                            mkBranch n ifc h@(Hierarchy pairs) = Block {
                                blockDeclarations = (transformNodeListToLocalDeclarations $ map fst pairs),
                                blockInstructions = Program {
                                    programConstruction = SequenceProgram $ Sequence { 
                                        sequenceProgramList = (copyResult inp (interfaceInput ifc) inTyp False
                                                       ++ transformNodeListToPrograms  pairs
                                                       ++ copyResult (interfaceOutput ifc) (nodeId n) (outputType n) True),
                                        sequenceSemInf = ()
                                    },
                                    programSemInf = ()
                                },
                                blockSemInf = ()
                            }
                            condVar = case cond of
                                One (Graph.Variable (id,path)) ->
                                    Representation.Variable Value Representation.BoolType (varName id path) ()
                                _ -> error "Error in 'ifThenElse' node: condition is not a variable."
                                    -- TODO: it seems that in case of constant condition the program is already simplified on the graph level
            otherwise -> error $ "Error in 'ifThenElse' node: incorrect node input or node input type"
        otherwise -> error $ "Error in 'ifThenElse' node: two hierarchies expected, found " ++ show (length hs)
    -- while node:
        -- state variables: id of the while node
        -- condition calculation: first interface and hierarchy
            -- input gets the state
        -- condition: output of condition calculation
        -- body: second interface and hierarchy
            -- input gets the state
            -- output is written back to the state
    While condIfc bodyIfc   -> Program {
        programConstruction = SequenceProgram $ Sequence {
            sequenceProgramList =
                (copyResult (input n) (nodeId n) (outputType n) True ++
                    [Program {
                    programConstruction = SequentialLoopProgram $ SequentialLoop {
                        sequentialLoopCondition = (case interfaceOutput condIfc of
                            One (Graph.Variable (id,path)) -> varToExpr $ Representation.Variable Value Representation.BoolType (varName id path) ()
                            One (Graph.Constant (BoolData x)) -> Expression {
                                expressionData = ConstantExpression $ Representation.Constant {
                                    constantData = BoolConstant $ BoolConstantType x (),
                                    constantSemInf = ()
                                },
                                expressionSemInf = ()
                            }
                            unknown -> error $ "Error in a while loop: Malformed interface output of condition calculation: " ++ (show unknown) 
                                -- TODO: should this hold?
                        ),
                        conditionCalculation = Block {
                            blockDeclarations = (transformNodeListToLocalDeclarations condNodes),
                            blockInstructions = Program {
                                programConstruction = (SequenceProgram (Sequence (copyStateToCond ++ calculationCond) ())),
                                programSemInf = ()
                            },
                            blockSemInf = ()
                        },
                        sequentialLoopCore = Block {
                            blockDeclarations = (transformNodeListToLocalDeclarations bodyNodes),
                            blockInstructions = Program {
                                programConstruction = (SequenceProgram (Sequence (copyStateToBody ++ calculationBody ++ copyResultToState) ())),
                                programSemInf = ()
                            },
                            blockSemInf       = ()
                        },
                        sequentialLoopSemInf = ()
                   },
                   programSemInf = ()
                }
                ]),
            sequenceSemInf = ()
        },
        programSemInf = ()
    }
            where
                (Hierarchy condHier, Hierarchy bodyHier) = case hs of
                    [c,b]   -> (c,b)
                    _       -> error $ "Error in a while node: expected 2 hierarchies, but found " ++ show (length hs)
                condNodes = map fst condHier
                bodyNodes = map fst bodyHier
                copyStateToCond = copyNode (nodeId n) (interfaceInput condIfc) (outputType n) False
                calculationCond = transformNodeListToPrograms  condHier
                copyStateToBody = copyNode (nodeId n) (interfaceInput bodyIfc) (outputType n) False
                calculationBody = transformNodeListToPrograms  bodyHier
                copyResultToState = copyResult (interfaceOutput bodyIfc) (nodeId n) (outputType n) True
    -- parallel node:
        -- number of iterations: first parameter of 'Parallel' constructor
            -- (vs. input of the node, may change later)
        -- index variable: input node of the embedded graph
        -- body: embedded graph and its interface
    Parallel ifc  ->
        Program {
            programConstruction = ParallelLoopProgram $ ParallelLoop 
                    (Representation.Variable Value (Numeric ImpSigned S32) (varName inpId []) ()) num 1 prg
                    (),
            programSemInf = ()
        } where
            num = case (input n, inputType n) of
                (One inp, One intyp)    -> transformSourceToExpr inp intyp
                otherwise               -> error "Invalid input of a Parallel node."
            hist = case hs of
                [(Hierarchy hist)] -> hist
                _                  -> error "More than one Hierarchy in a Parallel construct"  
            isInp (node,hs) = case (function node) of
                Graph.Input -> True
                _           -> False
            (inps,notInps) = partition isInp hist
            inpId = case inps of
                [(node,hs)] -> nodeId node
                _           -> error "More than one input node inside the Hierarchy of a Parallel construct" 
            topLevelNodes = map fst notInps
            declarations = concatMap transformNodeToLocalDeclaration topLevelNodes
            outSrc = case interfaceOutput ifc of
                One src -> src
                _       -> error "The interfaceOutput of a Parallel is not (One ...) "
            outTypElem = case interfaceOutputType ifc of
                One typ -> typ
                _       -> error "The interfaceOutputType of a Parallel is not (One ...) "
            outTypArray = case outputType n of
                One typ -> typ
                _       -> error "The outputType of a Parallel is not (One ...) "
            outTypArrayImp = compileStorableType outTypArray
            outTypElemImp =  compileStorableType outTypElem
            prg = Block {
                blockDeclarations = declarations,
                blockInstructions = Program {
                    programConstruction = SequenceProgram $ Sequence {
                        sequenceProgramList = map transformNodeToProgram notInps ++
                          [ Program {
                                programConstruction = PrimitiveProgram $ Primitive {
                                    primitiveInstruction = makeCopyFromExprs
                                        (transformSourceToExpr outSrc outTypElem)
                                        (Expression {
                                            expressionData = LeftValueExpression $ LeftValue {
                                                leftValueData = (ArrayElemReferenceLeftValue $ ArrayElemReference {
                                                    arrayName = LeftValue {
                                                        leftValueData = VariableLeftValue $ Representation.Variable {
                                                            variableRole = Value,                   
                                                            variableType = outTypArrayImp,
                                                            variableName = (varName (nodeId n) []),
                                                            variableSemInf = ()
                                                        },
                                                        leftValueSemInf = ()
                                                    },
                                                    arrayIndex = (genVar inpId [] intType),
                                                    arrayElemReferenceSemInf = ()
                                                }),
                                                leftValueSemInf = ()
                                            },
                                            expressionSemInf = ()
                                        }),
                                    primitiveSemInf = True
                                },
                                programSemInf = ()
                            } ],
                        sequenceSemInf = ()
                    },
                    programSemInf = ()
                },
                blockSemInf = ()
            }

transformNodeListToPrograms :: [(Node, [Hierarchy])] -> [Program InitSemInf]
transformNodeListToPrograms pairs = map transformNodeToProgram pairs


-- Generates the common prefix of variables belonging to the given node id.
varPrefix :: NodeId -> String
varPrefix id = "var" ++ show id

-- Generates a variable's id list that describes the variable's location
-- inside the nodes it belongs to.
varPath :: [Int] -> String
varPath path = concatMap (\id -> '_' : show id) path

-- Generates a variable from its id and location.
varName :: NodeId -> [Int] -> String
varName id path = varPrefix id ++ varPath path

-- Generates a variable
genVar :: NodeId -> [Int] -> Type -> Expression InitSemInf
genVar id path typ = Expression {
    expressionData = LeftValueExpression $ LeftValue {
        leftValueData = VariableLeftValue $ Representation.Variable {
            variableRole = Value,
            variableType = typ,
            variableName = (varName id path),
            variableSemInf = ()
        },
        leftValueSemInf = ()
    },
    expressionSemInf = ()
}

-- Prefix of output parameters
outPrefix :: String
outPrefix = "out"

-- Generaes the name of an output parameter
outName :: [Int] -> String
outName path = outPrefix ++ varPath path

-- Generates an output variable
genOut :: [Int] -> Type -> Expression InitSemInf
genOut path typ = Expression {
    expressionData = LeftValueExpression $ LeftValue {
        leftValueData = VariableLeftValue $ Representation.Variable {
            variableRole = FunOut,
            variableType = typ,
            variableName = (outName path),
            variableSemInf = ()
        },
        leftValueSemInf = ()
    },
    expressionSemInf = ()
}

-- Generates input parameters of a function call from the node input.
passInArgs :: Tuple Source -> Tuple StorableType -> [ActualParameter InitSemInf]
passInArgs tup typs = tupleWalk genArg $ tupleZip (tup,typs) where
    genArg _ (Graph.Constant primData, StorableType _ typ) = ActualParameter {
        actualParameterData = InputActualParameter $ compilePrimData primData typ,
        actualParameterSemInf = ()
    }
    genArg _ (Graph.Variable (id, path), typ) = ActualParameter {
        actualParameterData = InputActualParameter $ genVar id path (compileStorableType typ),
        actualParameterSemInf = ()
    }

-- Generates output parameters of a function call from the node id and output type.
passOutArgs :: NodeId -> Tuple StorableType -> [ActualParameter InitSemInf]
passOutArgs id typs = tupleWalk genArg typs where
    genArg path t = ActualParameter {
        actualParameterData = OutputActualParameter $ toLeftValue $ genVar id path (compileStorableType t),
        actualParameterSemInf = ()
    }

-------------------------------------------------
-- Compilation of type and data representation --
-------------------------------------------------

-- Transforms a 'StorableType' to an imperative 'Type'
compileStorableType :: StorableType -> Type
compileStorableType (StorableType dims elemTyp) = case dims of
    []      -> compilePrimitiveType elemTyp
    (d:ds)  -> ImpArrayType (getLength $ upperBound d) $ compileStorableType $ StorableType ds elemTyp

getLength (Just i) = Norm i
getLength _ = Undefined

-- Transforms a 'PrimitiveType' to an imperative 'Type'
compilePrimitiveType :: PrimitiveType -> Type
compilePrimitiveType typ = case typ of
    UnitType            -> Representation.BoolType
    CoreTypes.BoolType  -> Representation.BoolType
    IntType True 8 _    -> Numeric ImpSigned S8
    IntType True 16 _   -> Numeric ImpSigned S16
    IntType True 32 _   -> Numeric ImpSigned S32
    IntType True 64 _   -> Numeric ImpSigned S64
    IntType False 8 _   -> Numeric ImpUnsigned S8
    IntType False 16 _  -> Numeric ImpUnsigned S16
    IntType False 32 _  -> Numeric ImpUnsigned S32
    IntType False 64 _  -> Numeric ImpUnsigned S64
    IntType sig size _  -> handleError "GraphToImperative" InvariantViolation $ "unknown integer type: IntType" ++ (show sig) ++ " " ++ (show size)
    CoreTypes.FloatType x -> Representation.FloatType    -- TODO: think about the imperative typesystem!
    CoreTypes.UserType userTypeName -> Representation.UserType userTypeName

-- Transforms an array or primitive data to an imperative constant.
compileStorableDataToConst :: StorableData -> Constant InitSemInf
compileStorableDataToConst (CoreTypes.PrimitiveData pd) = compilePrimDataToConst pd
compileStorableDataToConst (StorableData ds) = Representation.Constant {
    constantData = ArrayConstant $ ArrayConstantType (map compileStorableDataToConst ds) (),
    constantSemInf = ()
}

-- Transforms a primitive data to an imperative constant.
compilePrimDataToConst :: CoreTypes.PrimitiveData -> Constant InitSemInf
compilePrimDataToConst (UnitData ()) = Representation.Constant {
    constantData = BoolConstant $ BoolConstantType False (),
    constantSemInf = ()
}
compilePrimDataToConst (BoolData x) = Representation.Constant {
    constantData = BoolConstant $ BoolConstantType x (),
    constantSemInf = ()
}
compilePrimDataToConst (IntData x) = Representation.Constant {
    constantData = IntConstant $ IntConstantType (fromInteger x) (),
    constantSemInf = ()
}
compilePrimDataToConst (FloatData x) = Representation.Constant {
    constantData = FloatConstant $ FloatConstantType x (), -- TODO
    constantSemInf = ()
}

-- Transforms an array or primitive data to an imperative typed expression.
compileStorableData :: StorableData -> StorableType -> Expression InitSemInf
compileStorableData (CoreTypes.PrimitiveData pd) (StorableType _ elemTyp) = compilePrimData pd elemTyp
compileStorableData a@(StorableData ds) typ = Expression (ConstantExpression $ compileStorableDataToConst a) ()

-- Transforms a primitive data to an imperative typed expression.
compilePrimData :: CoreTypes.PrimitiveData -> PrimitiveType -> Expression InitSemInf
compilePrimData d t = Expression (ConstantExpression $ compilePrimDataToConst d) ()

charType = Numeric ImpSigned S8
intType = Numeric ImpSigned S32

-- Transforms a Source to an imperative expression.
transformSourceToExpr :: Source -> StorableType -> Expression InitSemInf
transformSourceToExpr (Graph.Constant primData) (StorableType _ typ) = compilePrimData primData typ
transformSourceToExpr (Graph.Variable (id,path)) typ = genVar id path ctyp
    where
        ctyp = compileStorableType typ

-- Generates a copy call from variable ids and types.
makeCopyFromIds :: (NodeId,[Int],StorableType) -> (NodeId,[Int],StorableType) -> Instruction InitSemInf
makeCopyFromIds (idFrom,pathFrom,typeFrom) (idTo,pathTo,typeTo) =
    makeCopyFromExprs
        (genVar idFrom pathFrom ctypFrom)
        (genVar idTo pathTo ctypTo)
            where
                ctypTo = compileStorableType typeTo
                ctypFrom = compileStorableType typeFrom

-- Generates a copy call from two expressions.
makeCopyFromExprs :: Expression InitSemInf -> Expression InitSemInf -> Instruction InitSemInf
makeCopyFromExprs from to = Instruction {
    instructionData = ProcedureCallInstruction $ ProcedureCall {
        nameOfProcedureToCall = "copy",
        actualParametersOfProcedureToCall = [ActualParameter {
                                                actualParameterData = InputActualParameter from,
                                                actualParameterSemInf = ()
                                            },
                                            ActualParameter {
                                                actualParameterData = OutputActualParameter $ toLeftValue to,
                                                actualParameterSemInf = ()
                                            }],
        procedureCallSemInf = ()
    },
    instructionSemInf = ()
}
    

-- Generates copies for all variables of a node to all variables of another node.
copyNode :: NodeId -> NodeId -> Tuple StorableType -> Bool -> [Program InitSemInf]
copyNode fromId toId typeStructure isOutputCopying =
    tupleWalk
        (\path typ -> 
            Program {
                programConstruction = PrimitiveProgram (Primitive {
                    primitiveInstruction = (makeCopyFromIds (fromId,path,typ) (toId,path,typ)),
                    primitiveSemInf = isOutputCopying
                }),
                programSemInf = ()
            }
        )
        typeStructure

-- Generates copies from sources to all variables of a node.
copyResult :: Tuple Source -> NodeId -> Tuple StorableType -> Bool -> [Program InitSemInf]
copyResult ifcOut nid outTyp isOutputCopying =
    tupleWalk
        (\path (out,typ) ->
            Program {
                programConstruction = PrimitiveProgram (Primitive {
                    primitiveInstruction = (makeCopyFromExprs (transformSourceToExpr out typ) (genVar nid path $ compileStorableType typ)),
                    primitiveSemInf = isOutputCopying
                }),
                programSemInf = ()
            }
        )
        (tupleZip (ifcOut, outTyp))

-- Generates copies from sources to output variables.
copyToOutput :: Tuple Source -> Tuple StorableType -> Bool -> [Program InitSemInf]
copyToOutput ifcOut outTyp isOutputCopying =
    tupleWalk
        (\path (out,typ) ->
            Program {
                programConstruction = PrimitiveProgram $ Primitive {
                    primitiveInstruction = (makeCopyFromExprs (transformSourceToExpr out typ) (genOut path $ compileStorableType typ)),
                    primitiveSemInf = isOutputCopying
                },
                programSemInf = ()
            }
        )
        (tupleZip (ifcOut, outTyp))
    
    
varToExpr :: Representation.Variable InitSemInf -> Expression InitSemInf
varToExpr v = Expression {
  expressionData = LeftValueExpression $ LeftValue { 
    leftValueData = VariableLeftValue v, 
    leftValueSemInf = ()
  },
  expressionSemInf = ()
}