{-|
    Module      :  Functional.Compiler
    Copyright   :  (c) Daniel Mendes and Miguel Vilaça 2007
    Maintainer  :  danielgomesmendes@gmail.com and jmvilaca@di.uminho.pt
    Stability   :  experimental
    Portability :  portable

    Small Functional Language: Compiler -}
module Functional.Compiler ( compile) where

import Network
import InfoKind
import Palette
import Shape
import Document
import Ports
import Math
import List
import INRule
import INRules
import Common
import CommonUI

import Functional.Language

import Data.Maybe
import Data.List
import qualified Data.Map as Map


type Context = Map.Map Variable ConnectionPoint
data AgentType = Syntactical | Computational


-- | Given a strategy, a closed term and a list of names for iter agents,
-- update the document with the dynamic part of the IN system.
compile :: (Eq n, InfoKind n g, InfoKind e g) => g -> n -> e -> CallBy -> FuncLang -> [(FuncLang, String)] -> Document g n e -> IO (Document g n e)
compile g n e callBy term names doc
  | callBy `elem` [Name,Value] =
	-- add iter symbols
	let symbs = foldr (\h r->  createIterSymbol Syntactical h : createIterSymbol Computational h :r) [] names
 	    repeated = map fst symbs `intersect` (shapesNames $ getPalette doc)
	in if null repeated
	    then
	     do
		let    doc1 = joinPalette (Palette symbs) doc
	    	       palette = getPalette doc1
		tokenRules <- mapM (createIterTokenRule g n e palette) names
		lrules <- mapM (createIterConstructorRules g n e palette names) names
		return $ setNetwork (draw term names palette $ Network.empty g n e)
			$ updateRules (++ tokenRules ++ concat lrules) doc1
	    else fail $ "Give different names to iter symbols. This ones are already in use:\n"
			++ commasAnd repeated

  | otherwise = fail "unknown strategy"


-- | Create the main net.
draw ::(InfoKind n g, InfoKind e g) => FuncLang -> [(FuncLang, String)] -> Palette n -> Network g n e -> Network g n e
draw t names p network = let (x,net) = addNode "interface" p network
		             (n,net1) = addNode "evaluation" p net
		             net2 = setNodePosition n (DoublePoint 15 1.03)
				    .  setNodePosition x (DoublePoint 15 0.01)
		                    .  connectNodes p (x,"interface","interface") (n,"evaluation","res") $ net1
			 in iso p names (n,"evaluation","arg") (0,1.6) t Map.empty net2

-- | The \cal{T} function of the paper.
iso :: (InfoKind n g, InfoKind e g) => Palette n
	-> [(FuncLang, String)] -- ^ list of names for Iter_TYPE symbols
	-> ConnectionPoint -- point to connect the root of the IN term
	-> (Double,Double) -- translation from connection node
	-> FuncLang -- term to translate to INs
	-> Context -- free variables and their respective connection points
	-> Network g n e -- already constructed net
	-> Network g n e -- resulting net
iso palette names point trans term ctx net = -- trace ("ISO: TERM: " ++ show term ++ " CTX: " ++ show (Map.keys ctx)) $
     case term of
	Var v -> case Map.lookup v ctx of
			Just pointVar -> connectNodes palette point pointVar net
			Nothing -> error $ "Internal Error: variable \"" ++ v ++ "\" is not in context " ++ show (Map.keys ctx)

	Abst v t -> let (abstNr, net1) = addNode "lambda" palette net
                        net2           = connectNodes palette point (abstNr,"lambda","res")
					  . moveNode abstNr trans point
					  $ net1
			abstPoint = translate (getNodePosition net2 abstNr) (DoublePoint (-1) 1)
                        (net3, ctx1) = if v `elem` (freeVars t)
					then (net2, Map.insert v (abstNr,"lambda","var") ctx)
					else let (eraseNr,net4) = addNode "Erase" palette net2
					     in (connectNodes palette (eraseNr,"Erase","down") (abstNr,"lambda","var")
							$  setNodePosition eraseNr abstPoint net4, ctx)
                    in iso palette names (abstNr,"lambda","body") (1,1.2) t ctx1 net3

	Appl t u -> createNet2 "beforeApplication" t "func" u "arg"
	TT   -> createNet0 "True"
	FF   -> createNet0 "False"
	Zero -> createNet0 "Zero"
	Succ t -> createNet1 "Succ" t "arg"
	Nil  -> createNet0 "Nil"
	Cons t u -> createNet2 "Cons" t "head" u "tail"
	iter@(IterBool v f b)     -> createNetIter iter [(v, 'v'),(f, 'f')]                 b "arg"
	iter@(IterNat x s z n)    -> createNetIter iter [(Abst x s, 's'),(z, 'z')]          n "arg"
	iter@(IterList x y c n l) -> createNetIter iter [(Abst x $ Abst y c, 'c'),(n, 'n')] l "arg"
	_ -> error "Internal Error: none exaustive patterns in function iso."
  where
	-- | Create a net with the agent of arity 0 and connect it to the given point.
	-- createNet0 :: String -> Network g n e
	createNet0 agentName = let (nr, net1) = addNode agentName palette net
			     in connectNodes palette point (nr,agentName,"res")
				 $ moveNode nr trans point net1

	-- | Create a net with the agent of arity 1 and connect
	-- it to the given point and to the translation of the subterm.
	-- createNet1 :: String -> FuncLang -> PortName -> Network g n e
	createNet1 agentName term portName =
		   let (nr, net1) = addNode agentName palette net
		   in iso palette names (nr,agentName,portName) (0,1) term ctx
			. connectNodes palette point (nr,agentName,"res")
			. moveNode nr trans point
			$ net1

	-- | Create a net with the agent of arity 2 and connect it to the given
	-- point and to the subterms, taking care of shared variables.
	-- createNet2 :: String -> FuncLang -> PortName -> FuncLang -> PortName -> Network g n e
	createNet2 agentName tLeft portLeft tRight portRight =
		    let (nr, net1) = addNode agentName palette net
                        net2       = connectNodes palette point (nr,agentName,"res")
					. moveNode nr trans point
					$  net1
			(net3, [ctxL,ctxR]) = shareCommonVariables palette [tLeft, tRight] ctx net2
                    in iso palette names (nr,agentName,portLeft) (-5,1) tLeft ctxL
			. iso palette names (nr,agentName,portRight) (5,1) tRight ctxR
			$ net3

	-- | Create a net with the iter agent and connect it to the given
	-- point and to the subterms, taking care of shared variables.
	-- createNetIter :: FuncLang -- iter_TYPE term
	-- 	-> [(FuncLang, Char)] -- list of sub terms and respective port prefixs
	-- 	-> FuncLang -- middle (arg) sub term
	-- 	-> PortName -- middle (arg) port name
	-- 	-> Network g n e
	createNetIter term l tMiddle portMiddle =
	  case lookupIterName term names of
	    Just agentName ->
		let (nr, net1) = addNode agentName palette net
                    net2       = connectNodes palette point (nr,agentName,"res")
				  . moveNode nr trans point
				  $ net1
		    (terms,portPrefixs) = unzip l
		    (net3, ctxM:ctxs) = shareCommonVariables palette (tMiddle:terms) ctx net2
		in iso palette names (nr,agentName,portMiddle) (0,1.5) tMiddle ctxM
		  . foldlCont (connect2Iter nr agentName) (zip portPrefixs ctxs)
		  $ net3
	    Nothing -> error $ "Internal Error: symbol " ++ show term ++ "not found in list of symbol's names."

	-- connect2Iter :: (InfoKind e g) => NodeNr -> String -> Network g n e -> (Char,Context) -> Network g n e
	connect2Iter nr agentName net (portPrefix, ctx) =
		connectPorts palette portPrefix nr agentName ctx net

-- | Connect the set of ports with prefix 'pF' from given agent to the context.
connectPorts :: (InfoKind e g) => Palette n ->
		Char -- port prefix
		-> NodeNr -- iter agent
		-> String -- iter agent
		-> Context
		-> Network g n e -> Network g n e
connectPorts palette pF iterNr iterAgent ctx net = Map.foldWithKey (connectIterZs iterNr) net ctx
  where -- connectIterZs :: (InfoKind e g) => NodeNr
	--		-> Variable -> ConnectionPoint -> Network g n e
	--		-> Network g n e
 	connectIterZs iterNr var point net =
		connectNodes palette (iterNr,iterAgent,pF:'_':var) point net


type RichCtx = Map.Map Variable [ConnectionPoint]

-- | Add as many copy agents as necessary for variables that are shared between sub-terms.
shareCommonVariables :: (InfoKind n g,InfoKind e g) =>
	Palette n
	-> [FuncLang] -- list of n subterms
	-> Context
	-> Network g n e
	-> (Network g n e, [Context]) -- new net with necessary copy agents
				      -- and n contexts: respectively for each subterm
shareCommonVariables palette l ctx net =
    let
	lVars = map freeVars l
	(net1, richCtx) =
		 Map.mapAccumWithKey copyPointInNet net . Map.mapWithKey count $ ctx
    in (net1, snd $ mapAccumL subTermCtx richCtx lVars)
  where
	lVars = map freeVars l

	count :: Variable -> ConnectionPoint -> (Int, ConnectionPoint)
	count var point = (length $ findIndices (var `elem`) lVars, point)

--	copyPointInNet :: (InfoKind n g,InfoKind e g) =>
--		Network g n e -> Variable -> (Int, ConnectionPoint)
--		-> (Network g n e, [ConnectionPoint])
	copyPointInNet net _ (0, point) = error "Internal Error in copyPointInNet"
	copyPointInNet net _ (1, point) = (net, [point])
	copyPointInNet net v (n, point) =
	    let (nNr, net1) = addNode "copy" palette net
		m = n `div` 2
		net2 = moveNode nNr (-1.5,1) point
			$ connectNodes palette point (nNr,"copy","src") net1
		(netL, pointsL) = copyPointInNet net2 v (m  , (nNr,"copy","fst_target"))
		(netR, pointsR) = copyPointInNet netL v (n-m, (nNr,"copy","snd_target"))
	    in (netR, pointsL ++ pointsR)



	subTermCtx :: RichCtx -> [Variable] -> (RichCtx, Context)
	subTermCtx richctx = (id >< Map.fromList) . mapAccumL variableCtx richctx

	variableCtx :: RichCtx -> Variable -> (RichCtx, (Variable,ConnectionPoint))
	variableCtx richctx var = (Map.adjust tail var richctx, (var, head $ richctx Map.! var))

-- | Connect unused variables to erase agents.
closeEpsilon ::(InfoKind n g, InfoKind e g) =>  Palette n -> Context -> Network g n e -> Network g n e
closeEpsilon pal ctx net = Map.fold aux net ctx
  where
	-- aux :: ConnectionPoint -> Network g n e -> Network g n e
	aux point nt = let (node_nr, n_nt) = addNode "Erase" pal nt
                       in connectNodes pal point (node_nr,"Erase","down")
			  . moveNode node_nr (0,-1) point
			  $ n_nt

createIterSymbol :: AgentType -> (FuncLang, String) -> (String, (Shape, Ports, Maybe a))
createIterSymbol at (term, name) = (name2, (shape, ports, Nothing))
  where
	(x,y) = (1.0, 1.0)
	topPosition = DoublePoint 0.0 (-y)
	name2 =  case at of
	 		Syntactical -> name
			Computational -> '^':name
	shape =
	 case at of
	  Syntactical -> -- triangle with text
	       Composite { shapeSegments =
		[ Polygon { shapeStyle =    ShapeStyle { styleStrokeWidth = 1
						       , styleStrokeColour = licorice
						       , styleFill = lightRed }
			  , shapePerimeter = [topPosition, DoublePoint (-x) 0.3, DoublePoint x 0.3] }
		, Text { shapeStyle = defaultShapeStyle
		       , shapeText = name }
		] }
	  Computational -> -- circle
	       TextInEllipse { shapeStyle = ShapeStyle { styleStrokeWidth = 1
						       , styleStrokeColour = licorice
						       , styleFill = lightRed }
			     , shapeText = name }
	(resP,argP) = case at of
			Syntactical    -> (("res", topPosition),("arg", DoublePoint 0.0 0.3))
			Computational -> (("arg", DoublePoint 0.0 0.3),("res", topPosition))

	ports =
	  case term of
	   IterBool v f (Var "") -> resP: portsFrom (-x) 'v' v ++ argP: portsFrom x 'f' f
	   IterNat a s z (Var "") -> resP: portsFrom (-x) 's' (Abst a s) ++ argP: portsFrom x 'z' z
	   IterList a b c n (Var "") -> resP: portsFrom (-x) 'c' (Abst a $ Abst b c) ++ argP: portsFrom x 'n' n
	   _ -> error "unexpected case"
	portsFrom :: Double -> Char -> FuncLang -> [Port]
	portsFrom pos char term = snd . mapAccumL (createPort char desc) pos $ freeVars term
	  where desc = (signum pos) * (-0.3)

createPort :: Char -> Double -> Double -> String -> (Double, Port)
createPort c desc x str = (x + desc, (c:'_':str, DoublePoint x 0.3))

createIterTokenRule :: (InfoKind n g, InfoKind e g) => g -> n -> e -> Palette n -> (FuncLang, String) -> IO (INRule g n e)
createIterTokenRule g n e palette (_, agent) =
     do
	(rule,nNr1,nNr2) <- createRuleWizard g n e palette "evaluation" agent
	portsEval <- getSymbolPorts "evaluation" palette
	return . updateRHS (f (map fst portsEval) ('^':agent) nNr1 nNr2) $ copyLHS2RHS rule
  where
	-- f :: (InfoKind e g) => [PortName] -> ShapeName -> NodeNr -> NodeNr -> Network g n e -> Network g n e
	f ["arg","res"] shape2 nNr1 nNr2 net =
		let pos1 = getNodePosition net nNr1
		    pos2 = getNodePosition net nNr2
		    mid = fromJust $ otherExtremeOfEdgeConnectedOnPort net nNr1 "arg"
		    top = fromJust $ otherExtremeOfEdgeConnectedOnPort net nNr1 "res"
		    bot = fromJust $ otherExtremeOfEdgeConnectedOnPort net nNr2 "arg"
		    arc1 = fromJust $ edgeConnectedOnPort net nNr1 "arg"
		    arc2 = fromJust $ edgeConnectedOnPort net nNr1 "res"
		    arc3 = fromJust $ edgeConnectedOnPort net nNr2 "arg"

		in addEdges palette
			[ ((nNr2,"arg"),(nNr1,"res")) -- (iter,arg) |-> (token,res)
			, (top,(nNr2,"res")) -- top interface |-> (iter,res)
			, ((nNr1,"arg"), bot) -- (token,arg) |-> bottom interface
			]
		   . removeEdge arc1 . removeEdge arc2 . removeEdge arc3
		   . setNodeShape nNr2 shape2 -- change symbol iter to ^iter
		   . setNodePosition nNr1 pos2 . setNodePosition nNr2 pos1 -- swap positions
		   $ net
	f _ _ _ _ _ = error $ "Internal Error: creating rule for token and " ++ agent

createIterConstructorRules :: (InfoKind n g, InfoKind e g) => g -> n -> e -> Palette n -> [(FuncLang, String)] -> (FuncLang, String) -> IO (INRules g n e)
createIterConstructorRules g n e palette names (term, agent) =
	mapM (createIterConstructorRule g n e palette names (term, agent) ) constructorAgents
	where constructorAgents = case term of
		IterBool _ _ (Var "") -> ["True","False"]
		IterNat _ _ _ (Var "") -> ["Zero","Succ"]
		IterList _ _ _ _ (Var "") -> ["Nil","Cons"]
		-- new Iterators
		_ -> error "Internal Error: iterator term expected and something different found."


data InterfaceID =
	RES ConnectionPoint
	| SuccArg ConnectionPoint
	| ConsHead ConnectionPoint
	| ConsTail ConnectionPoint
	| IterBoolV Context
	| IterBoolF Context
	| IterNatS Context
	| IterNatZ Context
	| IterListC Context
	| IterListN Context
	deriving(Eq,Ord,Show)

equalIID :: InterfaceID -> InterfaceID -> Bool
equalIID (RES _)       (RES _)       = True
equalIID (SuccArg _)   (SuccArg _)   = True
equalIID (ConsHead _)  (ConsHead _)  = True
equalIID (ConsTail _)  (ConsTail _)  = True
equalIID (IterBoolV _) (IterBoolV _) = True
equalIID (IterBoolF _) (IterBoolF _) = True
equalIID (IterNatS _)  (IterNatS _)  = True
equalIID (IterNatZ _)  (IterNatZ _)  = True
equalIID (IterListC _) (IterListC _) = True
equalIID (IterListN _) (IterListN _) = True
equalIID _ _ = False

createIterConstructorRule :: (InfoKind n g, InfoKind e g) => g -> n -> e -> Palette n -> [(FuncLang, String)] -> (FuncLang, String) -> String -> IO (INRule g n e)
createIterConstructorRule g n e palette names (term, agent) agent2 =
     do
	(rule,nNr1,nNr2) <- createRuleWizard g n e palette ('^':agent) agent2
	let lhs = getLHS rule
	    (_:lPorts1) = map fst . maybe (error "Internal Error: unexpected Nothing") id $ getPorts palette lhs nNr1
	    (_:lPorts2) = map fst . maybe (error "Internal Error: unexpected Nothing") id $ getPorts palette lhs nNr2
	    groupedInterfaces = groupInterfaces lhs (nNr1, lPorts1) (nNr2, lPorts2)

	return . updateRHS (makeRHS term agent agent2 groupedInterfaces) $ copyLHSInterface2RHS rule
  where
	groupInterfaces :: Network g n e -> (NodeNr, [PortName]) -> (NodeNr, [PortName])
			-> [InterfaceID]
	groupInterfaces lhs (nNr1, auxPorts1) (nNr2, auxPorts2) =
		sort (f4 nNr1 auxPorts1) ++ f4 nNr2 auxPorts2
	  where
		f4 :: NodeNr -> [PortName] -> [InterfaceID]
		f4  nNr = map (f3 lhs nNr) . groupBy aux

	f3 :: Network g n e -> NodeNr -> [PortName] -> InterfaceID
	f3 net nNr = aux3
	  where
		aux3 [p@"res" ] = RES $ f2 p
		aux3 [p@"head"] = ConsHead $ f2 p
		aux3 [p@"tail"] = ConsTail $ f2 p
		aux3 [p@"arg" ] = SuccArg $ f2 p
		aux3 l@(('v':'_':_):_) = IterBoolV . f6 $ l
		aux3 l@(('f':'_':_):_) = IterBoolF . f6 $ l
		aux3 l@(('s':'_':_):_) = IterNatS  . f6 $ l
		aux3 l@(('z':'_':_):_) = IterNatZ  . f6 $ l
		aux3 l@(('c':'_':_):_) = IterListC . f6 $ l
		aux3 l@(('n':'_':_):_) = IterListN . f6 $ l
		aux3 _		 = error "Internal Error in aux3"

		f2 :: PortName -> ConnectionPoint
		f2 = f4 . maybe (error "Internal Error: unexpected Nothing") id . otherExtremeOfEdgeConnectedOnPort net nNr

		f4 (nNr,"interface") = (nNr,"interface","interface")
		f4 _ = error "Internal Error: unexpected agent"

		f5 (_:'_':portName) = portName
		f5 _ = error "Internal Error: unexpected port name"

		f6 = Map.fromList . map (f5 /\ f2)

	-- makeRHS :: FuncLang -> String -> String -> [InterfaceID] -> Network g n e -> Network g n e
	makeRHS term iterAgent consAgent (RES interfacePoint:lInters) net =
		let (conE,net1) = connectToken palette interfacePoint net
		in reallyMakeRHS palette names term iterAgent consAgent lInters conE net1
	makeRHS _ _ _ _ _ = error "Internal Error making RHS."

-- | Add a token agent and connect its auxiliar port to the given point.
connectToken :: (InfoKind n g, InfoKind e g) => Palette n -> ConnectionPoint -> Network g n e -> (ConnectionPoint, Network g n e)
connectToken palette topPoint net =
	let (nNrE, net1) = addNode "evaluation" palette net -- add token agent
	in ( (nNrE,"evaluation","arg")
	   , connectNodes palette (nNrE, "evaluation", "res") topPoint -- (token, res) |-> topPoint
		. moveNode nNrE (0,1) topPoint
		$ net1 )

aux :: PortName -> PortName -> Bool
aux (c1:'_':_) (c2:'_':_) = c1 == c2
aux _ _ = False

-- | Creates the network that is the RHS of rule for given symbols.
-- See interaction rules for iterators in paper
-- "Encoding Iterators in Interaction Nets" for more details.
reallyMakeRHS :: (InfoKind n g, InfoKind e g)
	      => Palette n
	      -> [(FuncLang, String)]
	      -> FuncLang -- Iter_TYPE args (Var "")
	      -> String -- iter agent name
	      -> String -- constructor agent name
	      -> [InterfaceID] -> ConnectionPoint
	      -> Network g n e -> Network g n e
reallyMakeRHS palette names term iterAgent const l point =
 case (term, const) of
   (IterBool v _ (Var ""), "True") ->
     case emptyfy l [IterBoolV emp, IterBoolF emp] of
	[IterBoolV ctxV, IterBoolF ctxF] -> simpleRHS palette names point ctxV ctxF v
	_ -> error "Internal Error: unexpected [InterfaceID]"
   (IterBool _ f (Var ""), "False") ->
     case emptyfy l [IterBoolV emp, IterBoolF emp] of
	[IterBoolV ctxV, IterBoolF ctxF] -> simpleRHS palette names point ctxF ctxV f
	_ -> error "Internal Error: unexpected [InterfaceID]"
   (IterNat _ _ z (Var ""), "Zero") ->
     case emptyfy l [IterNatS emp, IterNatZ emp] of
	[IterNatS ctxS, IterNatZ ctxZ] -> simpleRHS palette names point ctxZ ctxS z
	_ -> error "Internal Error: unexpected [InterfaceID]"
   (IterNat x s _ (Var ""), "Succ") ->
     case emptyfy l [IterNatS emp, IterNatZ emp, SuccArg undef] of
	[IterNatS ctxS, IterNatZ ctxZ, SuccArg pSucArg] ->
	   oneRecursiveCallRHS palette names point ctxS emp ctxZ pSucArg x s iterAgent 'z' 's'
	_ -> error "Internal Error: unexpected [InterfaceID]"
   (IterList _ _ _ n (Var ""), "Nil") ->
     case emptyfy l [IterListC emp, IterListN emp] of
	[IterListC ctxC, IterListN ctxN] -> simpleRHS palette names point ctxN ctxC n
	_ -> error "Internal Error: unexpected [InterfaceID]"
   (IterList x y c _ (Var ""), "Cons") ->
     case emptyfy l [IterListC emp, IterListN emp, ConsHead undef, ConsTail undef] of
	[IterListC ctxC, IterListN ctxN, ConsHead pConsHead, ConsTail pConsTail] ->
	   oneRecursiveCallRHS palette names point ctxC (Map.singleton x pConsHead) ctxN pConsTail y c iterAgent 'n' 'c'
	_ -> error "Internal Error: unexpected [InterfaceID]"
   _ -> error "Undefined case making RHS."
  where emp = Map.empty
	undef = (0,"INVALID NODE","")

emptyfy :: [InterfaceID] -> [InterfaceID] -> [InterfaceID]
emptyfy given needed = map (\e -> maybe e id $ find (equalIID e) given ) needed


-- | Defines a simple RHS that evaluates the translation of term t
-- connecting its free variables to the corresponding interface agents
-- and connects the remaing interface agents to erase agents.
-- For example RHS for rule  IterBool |X| TT  that is
--  \TOKEN(T(V))
simpleRHS :: (InfoKind n g, InfoKind e g)
	=> Palette n
	-> [(FuncLang, String)]
	-> ConnectionPoint
	-> Context -- context to connect
	-> Context -- context to erase
	-> FuncLang -- term to translate
	-> Network g n e -> Network g n e
simpleRHS palette names point goodCtx eraCtx term = -- trace ("simpleRHS: POINT: " ++ show point ++ " GOODCTX" ++ show (Map.keys goodCtx) ++ " ERACTX: " ++  show (Map.keys eraCtx) ++" TERM: " ++ show term ) $
	iso palette names point (2,0) term goodCtx
	. closeEpsilon palette eraCtx


-- | Defines a RHS with one recursive call.
-- Like    IterNat |X| suc    or    IterList |X| cons
oneRecursiveCallRHS :: (InfoKind n g, InfoKind e g)
	=> Palette n
	-> [(FuncLang, String)]
	-> ConnectionPoint -- (token, arg) port to connect generated net
	-> Context -- context to connect to copy
	-> Context -- context to pass to translate function; refers to arguments of constructor
	-> Context -- context to connect to iterator
	-> ConnectionPoint -- interface for place to apply recursion
	-> Variable -- variable that represents result of recursive call
	-> FuncLang -- term to translate
	-> String -- Iterator agent name
	-> Char -- port prefix for final elements
	-> Char -- port prefix for cont elements
	-> Network g n e -> Network g n e
oneRecursiveCallRHS palette names topPoint copyCtx argCtx stopCtx argPoint var term iterAgent pF pC net =
  let (newNet, newCtx) =
	if var `elem` lFreeVars
	then
    	  let
   		(iterNr,net1) = addNode iterAgent palette net -- add iter agent
		(net2, ctxNew)  = Map.mapAccumWithKey (connectCopies iterNr) net1 copyCtx -- (Iter, FV(S)) |-> (copy, snd_target)
											  -- (copy, src) |-> copyCtx
    	  in ( connectNodes palette (iterNr,iterAgent,"arg") argPoint -- (Iter, arg) |-> argInterface
		. connectPorts palette pF iterNr iterAgent stopCtx -- (Iter, FV(Z)) |-> stopCtx
		. moveNode iterNr (0,-1) argPoint
		$ net2, Map.insert var (iterNr,iterAgent,"res") ctxNew )

	else (closeEpsilon palette (Map.insert "" argPoint stopCtx) net, copyCtx)
      (frees, dontExist) = Map.partitionWithKey aux argCtx

  in iso palette names topPoint (2,0.7) term (frees `Map.union` newCtx)
	. closeEpsilon palette dontExist
	$ newNet
   where
	lFreeVars = freeVars term

--	connectCopies :: NodeNr -> Network g n e -> Variable -> ConnectionPoint -> (Network g n e, ConnectionPoint)
	connectCopies iterNr net var point =
	  let (copyNr,net1) = addNode "copy" palette net
	  in (connectNodes palette (iterNr,iterAgent,pC:'_':var) (copyNr,"copy","snd_target")
		. connectNodes palette (copyNr,"copy","src") point
		. moveNode copyNr (0,-0.8) point
		$ net1, (copyNr,"copy","fst_target") )

	aux var _ = var `elem` lFreeVars

type ConnectionPoint =  ( NodeNr
			, ShapeName
			, PortName
			)

-- | Connect a port in a node to another.
connectNodes :: (InfoKind e g) => Palette n -> ConnectionPoint -> ConnectionPoint -> Network g n e -> Network g n e
connectNodes palette (nrFrom, shapeFrom, portFrom) (nrTo, shapeTo, portTo) net =
    case (getNodeShape net nrFrom, getNodeShape net nrTo) of
	(str1, str2) | str1 == shapeFrom && str2 == shapeTo ->
	    case (getPorts palette net nrFrom, getPorts palette net nrTo) of
		(Just portsFrom, Just portsTo) ->
		   case (Data.List.lookup portFrom portsFrom, Data.List.lookup portTo portsTo) of
			(Just _, Just _) ->
			   addEdge palette nrFrom portFrom nrTo portTo net
			(Nothing,_) -> error $ "Port \"" ++ portFrom ++ "\" do not exist in symbol \"" ++ shapeFrom ++ "\"."
			(_,Nothing) -> error $ "Port \"" ++ portTo ++ "\" do not exist in symbol \"" ++ shapeTo ++ "\"."
		_ -> error "No ports."
	_ -> error "Shapes do not coincide."

-- | Move first node to position @(dx,dy)@ relatively to reference point position.
moveNode :: NodeNr -> (Double,Double) -> ConnectionPoint -> Network g n e -> Network g n e
moveNode node (dx,dy) refPoint net =
	setNodePosition node ( translate (DoublePoint dx dy)
				   $ getNodePosition net $ fst3 refPoint)
	   net