implementation module iTasks.Gin.Parser

import StdBool
import StdArray
import StdEnum
from StdFunc import o,flip,seq
//import StdMisc
import StdList
import StdOrdList
import StdTuple
import StdClass, StdInt
import Data.Error

import GenPrint

from iTasks import class iTask
from iTasks.Gin.Types import generic gEq, generic JSONDecode, generic JSONEncode, generic gVerify, generic gUpdate, generic gDefault, generic gGridRows, generic gHeaders, generic gVisualizeText, generic gVisualizeEditor
from iTasks.Gin.Types import :: JSONNode, :: InteractionMask, :: VerifyMask, :: VerifyOptions, :: ConsPos, :: StaticVisualizationMode, :: VSt, :: VisualizationResult, :: GTypeExpression, :: GTypeDefinition
from iTasks.Gin.Types import printGTypeDefinition, typeIsDefined, printGTypeExpression
from iTasks.Gin.Printer import class Printer
//Clean-platform:
import Data.Graph
import Data.Map
import Data.Void
import Text.JSON
import Text

//Clean-compiler:

from general import :: Optional(..)
from syntax		import	
						::ArrayKind,
						::BasicValue,
						::Bind,
						::BoundExpr,
						::CaseAlt,
						::CodeBinding,
						::DynamicType,
						::ElemAssignment,
						::Env,
						::FieldAssignment,
						::FieldNameOrQualifiedFieldName,
						::FieldSymbol,
						::Global,
                        ::ModuleIdent(..),
						::Ident(..),
						::LocalDefs,
                        ::Optional(..),
						::OptionalRecordName(..),
						::ParsedExpr(..),
						::ParsedSelection,
						::ParsedSelectorKind,
						::Position,
						::Ptr,
						::Qualifier,
						::Sequence,
						::SymbolPtr,
						::SymbolTableEntry,
						::TypeKind

from CleanDocParser import parseExpressionUnsafe

//GiN:
import iTasks.Gin.Monad
import iTasks.Gin.Syntax
import iTasks.Gin.AbstractSyntax
import iTasks.Gin.FlowLibrary
import iTasks.Gin.ORYX
import iTasks.Gin.Storage

//--------------------------------------------------------------------------------------------------
//GParseState monadic combinators

derive class iTask GPathNode, GParseResult, GParseState

isParseError :: (GParseResult a) -> Bool
isParseError (GError _) = True
isParseError _ = False

getParseSuccess :: (GParseResult a) -> a
getParseSuccess (GSuccess a) = a

getParseError :: (GParseResult a) -> [(GPath, String)]
getParseError (GError b) = b

instance Monad GParseState
where
	ret :: a -> GParseState a
	ret a = GParseState (\path = GSuccess a)
	
	(>>>) infixr 5 :: (GParseState a) (a -> GParseState b) -> GParseState b
    (>>>) (GParseState m) k = GParseState (\path = case m path of
                                         GError errors = GError errors
                                         GSuccess a = strip (k a) path) where
          strip (GParseState f) = f
          
instance PathNode GNode
where
	getPathNode :: GNode GPath -> GPath
	getPathNode { GNode | identifier } _ = [NodePath identifier]

instance PathNode GEdge
where
	getPathNode :: GEdge GPath -> GPath
	getPathNode { GEdge | identifier} _ = [EdgePath identifier]
	
instance PathNode (String,GExpression)
where
	getPathNode :: (String,GExpression) GPath -> GPath
	getPathNode (s,_) path = [ParamPath s : path]
	
instance PathNode TreeGraph
where
	getPathNode :: TreeGraph GPath -> GPath
	getPathNode (TreeGraph graph source sink) path = getPathNode (fromJust (getNodeData source graph)) path

instance PathNode TreeGraphNode
where
	getPathNode :: TreeGraphNode GPath -> GPath
	getPathNode (TGNode node)         path = getPathNode node path 
	getPathNode (TGSubgraph subgraph) path = getPathNode subgraph path
	
parseChild :: a (GParseState b) -> GParseState b| PathNode a
parseChild child (GParseState f) = GParseState (\path = f (getPathNode child path))

parseMap :: (a -> GParseState b) [a] -> GParseState [b]
parseMap _ []     = ret []
parseMap f [x:xs] = f x >>> \x` = 
				                  parseMap f xs >>> \xs` = 
                                  ret [x`:xs`]

parseChildMap :: (a -> GParseState b) [a] -> GParseState [b]| PathNode a
parseChildMap f [] = ret []
parseChildMap f [x:xs] = parseChild x (f x) >>> \x` ->
						 parseChildMap f xs >>> \xs` ->
						 ret [x`:xs`]

orElse :: (GParseState a) (GParseState a) -> GParseState a
orElse (GParseState m) (GParseState k) = 
	GParseState (\p = case (m p) of
		GSuccess a    = GSuccess a
		GError errors = k p)

parseError :: String -> GParseState a
parseError message = GParseState (\path = GError [(path,message)])

parseErrorInChild :: a String -> GParseState b| PathNode a
parseErrorInChild child message = parseChild child (parseError message)

parseErrorInChildren :: [a] String -> GParseState b| PathNode a
parseErrorInChildren children message = GParseState (\path = GError [(getPathNode child path, message) \\ child <- children])

getCurrentPath :: GParseState GPath
getCurrentPath = GParseState (\path = GSuccess path)

runParse :: (GParseState a) -> GParseResult a
runParse (GParseState f) = f []

//-------------------------------------------------------------------------------------------
//Top-level conversion function

gToAModule :: !GModule !GinConfig !*World -> (GParseState AModule, *World)
gToAModule gmod =: { moduleKind = GCleanModule _ } config world
	= (parseError "Module does not have a graphical representation", world)
gToAModule gmod =: { moduleKind = GGraphicalModule definitions } config world
	# (res, world) = importModules config gmod.GModule.imports world
	| isError res = (parseError (fromError res), world)
	# imports = fromOk res
	# bindings = map getDefinitionBinding definitions
				 ++ (flatten o map getModuleBindings) imports
	= ( parseMap (gToADefinition bindings) definitions >>> \definitions = 
	    ret	{ AModule
			| name = gmod.GModule.name
			, types = gmod.GModule.types
			, imports = gmod.GModule.imports
			, definitions = definitions
			}
	  , world)

gToADefinition :: !Bindings !GDefinition -> GParseState ADefinition
gToADefinition bindings gdef
# graph = GGraphExpression (oryxDiagramToGraph bindings gdef.GDefinition.body)
= gToAExpression bindings graph >>> \body =
  ret { ADefinition 
      | name         = gdef.GDefinition.declaration.GDeclaration.name
      , formalParams = gdef.GDefinition.declaration.GDeclaration.formalParams
      , returnType   = gdef.GDefinition.declaration.GDeclaration.returnType
      , body         = body        
      , locals       = []
      }
      
gToAExpression :: !Bindings !GExpression -> GParseState (AExpression Void)
gToAExpression bindings (GUndefinedExpression) = parseError "Undefined expression"
gToAExpression bindings (GGraphExpression graph) = graphToAExpression bindings graph
gToAExpression bindings (GListExpression gexps) =
    parseMap (gToAExpression bindings) gexps >>> \aexps = 
    ret (List aexps)
gToAExpression bindings (GListComprehensionExpression glc) = 
    gToAListComprehension bindings glc >>> \alc = ret (ListComprehension alc)
gToAExpression bindings (GCleanExpression text) | size text == 0 = parseError "Clean expression is empty"
gToAExpression bindings (GCleanExpression text)                  = ret (Unparsed text)

putPathContext :: (AExpression Void) -> GParseState (AExpression Void)
putPathContext exp = getCurrentPath >>> \path -> ret (PathContext path exp)

gToAMaybeExpression :: !Bindings !(Maybe GExpression) -> GParseState (Maybe (AExpression Void))
gToAMaybeExpression bindings (Just exp) = gToAExpression bindings exp >>> \exp` = ret (Just exp`)
gToAMaybeExpression bindings Nothing = ret Nothing
    
gToAListComprehension :: !Bindings !GListComprehension -> GParseState (AListComprehension Void)
gToAListComprehension bindings glc = 
    gToAExpression bindings glc.GListComprehension.output >>> \output` =
    gToAExpression bindings glc.GListComprehension.input >>> \input` = 
    ret { output = output`
        , generators = NestedGeneratorList [Generator glc.GListComprehension.selector input`]
        , guards = map Unparsed (maybeToList glc.GListComprehension.guard)
        }

//--------------------------------------------------------------------------------------------------------------
//GGraph decomposition

graphToAExpression :: !Bindings !GGraph -> GParseState (AExpression Void)
graphToAExpression bindings graph =
	toTreeGraph graph >>> \tg ->
	ret (decompose bindings (tg)) >>> \tg ->
	treeGraphToAExpression bindings tg

:: TreeGraph = TreeGraph (Graph TreeGraphNode GEdge) NodeIndex NodeIndex
:: TreeGraphNode = TGNode GNode | TGSubgraph TreeGraph

isNode :: TreeGraphNode -> Bool
isNode (TGNode _) = True
isNode _          = False

isSubgraph :: TreeGraphNode -> Bool
isSubgraph (TGSubgraph _) = True
isSubgraph _             = False

fromNode :: TreeGraphNode -> GNode
fromNode (TGNode n) = n

fromSubgraph :: TreeGraphNode -> TreeGraph
fromSubgraph (TGSubgraph t) = t

toTreeGraph :: GGraph -> GParseState TreeGraph
toTreeGraph (GGraph graph)
# sources = filterNodes (\pred _ _ -> isEmpty pred) graph 
| isEmpty sources = parseError "No source node found"
| (not o isEmpty) (tl sources) = parseErrorInChildren (getNodes sources graph) "Source node is not unique" 
# sinks = filterNodes (\_ succ _ -> isEmpty succ) graph 
| isEmpty sinks = parseError "No sink node found"
| (not o isEmpty) (tl sinks) = parseErrorInChildren (getNodes sinks graph) "Sink node is not unique" 
= ret (TreeGraph (mapNodes (\n -> TGNode n) graph) (hd sources) (hd sinks))

edgePairs :: (Graph n e) EdgeIndex -> [(EdgeIndex,EdgeIndex)]
edgePairs graph startEdge = (diag2 (successorEdges startEdge graph) (predecessorEdges startEdge graph))

decompose :: Bindings TreeGraph -> TreeGraph
decompose bindings tg=:(TreeGraph g source sink)
	| nodeCount g == 1 = tg //Trivial graph: No decomposition possible
	# loop = (sink,source) 
	# pairs = edgePairs g loop
	= decomp (edgePairs g loop) loop (TreeGraph (addEdge emptyEdge loop g) source sink)
where
	decomp :: [(EdgeIndex,EdgeIndex)] EdgeIndex TreeGraph -> TreeGraph
	decomp [] loop (TreeGraph g source sink) = TreeGraph (removeEdge loop g) source sink
	decomp [(fromEdge,toEdge):edges] loop tg=:(TreeGraph g source sink)
		| not (   isParallelBinding (nodeName (fst fromEdge) g) (nodeName (snd toEdge) g) bindings
			   || isParallelBinding (nodeName (snd fromEdge) g) (nodeName (fst toEdge) g) bindings
			  ) = decomp edges loop tg
		# fromData = fromJust (getEdgeData fromEdge g)
		  toData   = fromJust (getEdgeData toEdge g)
		# comps = components (removeEdge fromEdge (removeEdge toEdge g))
		| isEmpty (tl comps) = decomp edges loop tg //try next pair
		# [g,s:_] = comps
		# (g,s) = if (nodeExists source g) (g,s) (s,g)
		| isTrivialGraph s = decomp edges loop tg
		# g = removeEdge loop g
		# (newNode,g) = addNode (TGSubgraph(decompose bindings (TreeGraph s (snd fromEdge) (fst toEdge)))) g //decompose subgraph s recursively
		# g = addEdge fromData (fst fromEdge,newNode) g
		# g = addEdge toData (newNode, snd toEdge) g
		# source = if (source == snd fromEdge) newNode source
		# sink = if (sink == fst toEdge) newNode sink
		= decompose bindings (TreeGraph g source sink)

treeGraphNodeToAExpression :: !Bindings !TreeGraphNode -> GParseState (AExpression Void)
treeGraphNodeToAExpression bindings (TGNode node) = nodeToAExpression bindings node
treeGraphNodeToAExpression bindings (TGSubgraph graph) = treeGraphToAExpression bindings graph

treeGraphToAExpression :: !Bindings !TreeGraph -> GParseState (AExpression Void)
treeGraphToAExpression bindings tg=:(TreeGraph graph source sink)
	| isEmptyGraph graph = parseErrorInChild tg "Empty graph"
	//Trivial subgraphs
	| isTrivialGraph graph
		= treeGraphNodeToAExpression bindings (fromJust (getNodeData (hd (nodeIndices graph)) graph))
	//Structured parallel subgraphs
	# mbParallel = parallelDecompose bindings tg
	| isJust mbParallel = parallelToAExpression bindings (fromJust mbParallel)
	//Sequential subgraphs
	| isSequential tg = sequenceToAExpression bindings tg
	//Other graphs
	= parseErrorInChild tg "Mapping not supported"

nodeToAExpression :: !Bindings !GNode -> GParseState (AExpression Void)
nodeToAExpression bindings node = 
	parseChild node
		(	( getNodeBinding node.GNode.name bindings >>> \nb = 
		      case nb.NodeBinding.parameterMap of 
		        NBBuiltIn = parseError "Node not allowed here"
		        NBPrefixApp = 
		            if (isEmpty node.GNode.actualParams)
		                (ret (Var node.GNode.name))
		                (argsToExpressions nb >>> \exps = ret (App [(Var node.GNode.name) : exps]))
				NBInfixApp fix prio = 
					argsToExpressions nb >>> \[exp1, exp2: _] -> 
					ret (AppInfix node.GNode.name fix prio exp1 exp2)
			) >>> putPathContext
		)
	where
		argsToExpressions :: NodeBinding -> GParseState [AExpression Void]
		argsToExpressions nb = parseChildMap (\(_,param) -> gToAExpression bindings param >>> putPathContext) 
	                	[(fromMaybe formalParam.GFormalParameter.name formalParam.GFormalParameter.title, actualParam) 
	                	\\ formalParam <- nb.NodeBinding.declaration.GDeclaration.formalParams 
	                	 & actualParam <- node.GNode.actualParams
	                	]

//-------------------------------------------------------------------------------------------
//Mapping of parallel subgraphs

parallelDecompose :: !Bindings !TreeGraph -> Maybe (GNode, GNode, [TreeGraphNode])
parallelDecompose bindings (TreeGraph graph sourceIndex sinkIndex)
	# branchIndices = directSuccessors sourceIndex graph
	| sort branchIndices <> sort (directPredecessors sinkIndex graph) = Nothing
	| not (isParallelBinding (nodeName sourceIndex graph) (nodeName sinkIndex graph) bindings) = Nothing
	# source = fromNode (fromJust (getNodeData sourceIndex graph))
	# sink = fromNode (fromJust (getNodeData sinkIndex graph))
	= Just (source, sink, [ fromJust (getNodeData n graph) \\ n <- branchIndices])

parallelToAExpression :: !Bindings (GNode, GNode, [TreeGraphNode]) -> GParseState (AExpression Void)
parallelToAExpression bindings (split, merge, branches) =
    parseChild split (
        getParallelBinding split.GNode.name merge.GNode.name bindings >>> \pb = 
        checkNrBranches pb (length branches) >>> \_ =
        setParallelParams bindings (split,merge) branches pb.ParallelBinding.parameterMap >>>
        putPathContext
    )

checkNrBranches :: !ParallelBinding !Int -> GParseState Void
checkNrBranches pb i = case pb.fixedNrBranches of
    Just n | n == i = ret Void
    Just n          = parseError ("(" +++ pb.split.GDeclaration.name  +++ "," +++ pb.merge.GDeclaration.name 
                      +++ ") must have " +++ fromInt n +++ " branches")
    Nothing = ret Void

setParallelParams :: !Bindings !(GNode, GNode) ![TreeGraphNode] !(AExpression PBParameter) -> GParseState (AExpression Void)
setParallelParams _ _ _ (Unparsed s) = ret (Unparsed s)
setParallelParams _ _ _ (Lit s) = ret (Lit s)
setParallelParams _ _ _ (Var i) = ret (Var i)
setParallelParams bindings (split,merge) branches (App exps) =
	parseMap (setParallelParams bindings (split,merge) branches) exps >>> \exps` = 
    ret (App exps`)
setParallelParams bindings (split,merge) branches (AppInfix i fix pred exp1 exp2) =
	setParallelParams bindings (split,merge) branches exp1 >>> \exp1` =
	setParallelParams bindings (split,merge) branches exp2 >>> \exp2` =
    ret (AppInfix i fix pred exp1` exp2`)
setParallelParams bindings (split,merge) branches (Case exp casealts) =
	setParallelParams bindings (split,merge) branches exp >>> \exp` =
	parseMap (setParallelParamsCase bindings (split,merge) branches) casealts >>> \casealts` =
	ret (Case exp` casealts`)
setParallelParams bindings (split,merge) branches (Lambda pat exp) =
    setParallelParams bindings (split,merge) branches exp >>> \exp` =
    ret (Lambda pat exp`)
setParallelParams bindings (split,merge) branches (Tuple exps) = 
    parseMap (setParallelParams bindings (split,merge) branches) exps >>> \exps` =
        ret (Tuple exps`)
setParallelParams bindings (split,merge) branches (List exps) = 
    parseMap (setParallelParams bindings (split,merge) branches) exps >>> \exps` =
        ret (List exps`)
setParallelParams bindings (split,merge) branches (Extension ext) = case ext of
    PBSplitParameter i = gToAExpression bindings (split.GNode.actualParams !! i)
    PBMergeParameter i = gToAExpression bindings (merge.GNode.actualParams !! i)
    PBBranch i = 
    	case branches of
    		[TGNode node] = if (node.GNode.name == "list comprehension")
    			(parseError "List comprehension not allowed here")
    			(nodeToAExpression bindings node)
    		_	= (treeGraphNodeToAExpression bindings (branches !! i))
	PBBranchList = 
		case branches of
			[TGNode node]
				= if (node.GNode.name == "list comprehension") (setListComprehension node) setList
			_	= setList
		where
		setListComprehension node = 
			getNodePattern node 0 >>> \generatorPattern -> 
			gToAExpression bindings (node.GNode.actualParams !! 1) >>> \generatorExpression ->
			getNodePattern node 2 >>> \guard ->
			gToAExpression bindings (node.GNode.actualParams !! 3) >>> \output ->
			ret
				( ListComprehension 
					{ AListComprehension
					| output = output
					, generators = NestedGeneratorList [Generator generatorPattern generatorExpression]
					, guards = if (trim guard == "") [] [Unparsed guard]
					}
				)
		setList = parseMap (treeGraphNodeToAExpression bindings) branches >>> \branches` ->
     				      ret (List branches`)

setParallelParamsCase :: !Bindings !(GNode, GNode) ![TreeGraphNode] !(ACaseAlt PBParameter) -> GParseState (ACaseAlt Void)
setParallelParamsCase bindings (split,merge) branches (CaseAlt pat exp) =
	setParallelParams bindings (split,merge) branches exp >>> \exp` =
	ret (CaseAlt pat exp`)

//-------------------------------------------------------------------------------------------
//Mapping of sequential subgraphs

isSequential :: TreeGraph -> Bool
isSequential graph = True //TODO: check if graph does not contain any parallel split or parallel merge node.

sequenceToAExpression :: !Bindings !TreeGraph -> GParseState (AExpression Void) 	
sequenceToAExpression bindings tg
	= parseChild tg (sequenceToAExpression` bindings tg)

sequenceToAExpression` :: !Bindings !TreeGraph -> GParseState (AExpression Void)
sequenceToAExpression` bindings tg=:(TreeGraph graph source sink)
	# mergeNodes = filter (\n -> nodeName n graph == "case merge"
	                       && not (isPathToMergeSink graph n sink)) (nodeIndices graph)
	# nvMap = buildNodeVarMap tg mergeNodes
	= parseMap (\i -> seqNodeToAExpr (hd (directSuccessors i graph)) sink mergeNodes nvMap >>> \iexp -> 
	            ret ("f" +++ toString i +++ " " +++ unwords (fromJust (get i nvMap)), iexp)) mergeNodes >>> \letExps ->
	  seqNodeToAExpr source sink mergeNodes nvMap >>> \exp -> 
	  ret if (isEmpty letExps) exp (Let letExps exp)
where
	seqNodeToAExpr :: !NodeIndex !NodeIndex ![NodeIndex] !NodeVarMap -> GParseState (AExpression Void)
	seqNodeToAExpr current sink mergeNodes nvMap
		# nodeData = (fromJust (getNodeData current graph))
		| current == sink = treeGraphNodeToAExpression bindings nodeData                    //1
		| isNode nodeData
			# node = fromNode nodeData
			# nodename = node.GNode.name
			| isMember current mergeNodes = 
				let f = Var ("f" +++ toString current) in 
				ret (case fromMaybe [] (get current nvMap) of
						[] = f
						xs = App [f : map Var xs]
					)
			| nodename == "case split" = caseNodeToAExpr current sink mergeNodes nvMap //3
			| nodename == "let" = letNodeToAExpr current sink mergeNodes nvMap      //4
			= seqNode` nodeData 
		= seqNode` nodeData
	where
		seqNode` nodeData
			# successors = directSuccessors current graph
			| not (isEmpty (tl successors)) = parseErrorInChild nodeData "Node cannot be used as split node"    //7
			# successor = hd successors
			| isPathToMergeSink graph successor sink = seqNodeToAExpr current current mergeNodes nvMap
			# edgePattern = (fromJust (getEdgeData (current, successor) graph)).pattern                   //5,6
		    = treeGraphNodeToAExpression bindings nodeData        >>> \first`  -> 
		      seqNodeToAExpr successor sink mergeNodes nvMap >>> \second` ->
			    ret (case edgePattern of 
		    			Just p  = (AppInfix ">>=" Infixl 1 first` (Lambda p second`))
				    	Nothing = (AppInfix ">>|" Infixl 1 first` second`)
			    	)

	caseNodeToAExpr :: NodeIndex NodeIndex [NodeIndex] NodeVarMap -> GParseState (AExpression Void)
	caseNodeToAExpr current sink mergeNodes nvMap
		# nodeData = fromJust (getNodeData current graph)
		# node = fromNode nodeData
		# successors = directSuccessors current graph
		| isEmpty successors = parseErrorInChild node "Missing node(s) after case split"
		| or [ isPathToMergeSink graph s sink \\ s <- successors ] = parseErrorInChild node "Missing task in branch" //TODO: Highlight branch
		# caseExpression = node.GNode.actualParams
		= parseChild node (gToAExpression bindings (node.GNode.actualParams !! 0)) >>> \caseExpr -> 
		  parseMap (\n -> seqNodeToAExpr n sink mergeNodes nvMap >>> \exp -> 
		            ret (fromJust (getEdgeData (current,n) graph), exp)) successors >>> \caseAlts ->
		  if (length (filter (\{pattern} -> isNothing pattern) (map fst caseAlts)) > 1)
			(parseErrorInChild node "A case expression can have at most one default case")
			//"otherwise" alternative is put at the end of the list
			//TODO: Sort according to diagram layout.
			(ret (let sortAlts = filter (not o isEmptyEdge o fst) caseAlts ++ filter (isEmptyEdge o fst) caseAlts
			    in Case caseExpr (map mkCaseAlt sortAlts)))
	where
		isEmptyEdge :: GEdge -> Bool
		isEmptyEdge {pattern = Nothing  } = True
		isEmptyEdge {pattern = Just pat } = size (trim pat) == 0
	
		mkCaseAlt :: (GEdge, AExpression Void) -> ACaseAlt Void
		mkCaseAlt ({pattern = Just pat}, exp) = CaseAlt pat exp
		mkCaseAlt ({pattern = Nothing }, exp)  = CaseAlt "otherwise" exp
		  
	letNodeToAExpr :: NodeIndex NodeIndex [NodeIndex] NodeVarMap -> GParseState (AExpression Void)
	letNodeToAExpr current sink mergeNodes nvMap
		# nodeData = (fromJust (getNodeData current graph))
		# node = fromNode nodeData
		# successors = directSuccessors current graph
		| isEmpty successors = parseErrorInChild node "Missing node after let"
		| not (isEmpty (tl successors)) = parseErrorInChild node "Let cannot be used as split node"
		| isPathToMergeSink graph (hd successors) sink = parseErrorInChild node "Missing task in branch"
		= getNodePattern node 0 >>> \pat ->
		  gToAExpression bindings (node.GNode.actualParams !! 1) >>> \exp -> 
		  seqNodeToAExpr (hd successors) sink mergeNodes nvMap >>> \inExpr ->
		  ret (App [Lambda pat inExpr, exp])

nodeName :: NodeIndex (Graph TreeGraphNode e) -> String
nodeName nodeIndex graph = case fromJust (getNodeData nodeIndex graph) of
	TGNode{ GNode | name } = name
	_                     = ""

getNodePattern :: GNode Int -> GParseState String
getNodePattern node index = parseChild node (getTextExpr (node.GNode.actualParams !! index))
where
	getTextExpr :: GExpression -> GParseState String
	getTextExpr (GCleanExpression exp) | exp == "" = parseError "Pattern is empty"
									   | otherwise = ret exp
	getTextExpr f = parseError "Expected: textual expression"
	
getNodes :: [NodeIndex] (Graph n e) -> [n]
getNodes nodes graph = catMaybes [ getNodeData n graph\\ n <- nodes ]

//--------------------------------------------------------------------------------------------------
isPathToMergeSink :: (Graph TreeGraphNode GEdge) NodeIndex NodeIndex -> Bool
isPathToMergeSink graph current sink
	# nodeData = fromJust (getNodeData current graph)
	| isSubgraph nodeData = False
	# node = fromNode nodeData
	| node.GNode.name <> "case merge" = False
	| current == sink = True
	= case directSuccessors current graph of
		[n] = isPathToMergeSink graph n sink
		_   = False

:: NodeVarMap :== Map NodeIndex Vars

buildNodeVarMap :: TreeGraph [NodeIndex] -> NodeVarMap
buildNodeVarMap (TreeGraph graph source sink) mergeNodes
	= fromList [(n, getNodeVars n) \\ n <- mergeNodes ]
where
	getNodeVars :: NodeIndex -> Vars
	getNodeVars node
		# freeVars = freeVarsAfter graph node
		# boundVars = mergeVars [boundVarsBefore graph (p,node) \\ p <- directPredecessors node graph]
		= [ v \\ v <- freeVars | isMember v boundVars ]

freeVarsAfter :: (Graph TreeGraphNode GEdge) NodeIndex -> Vars
freeVarsAfter graph startNode = freeVarsAfter` [(startNode,emptyScope)] newMap
where
	freeVarsAfter` :: [(NodeIndex, Scope)] (Map NodeIndex Scope) -> Vars
	freeVarsAfter` [] visitedMap = []
	freeVarsAfter` [(n,scope):ns] visitedMap
		# newVars = [v \\ v <- freeVarsInNode (fromJust (getNodeData n graph)) | not (isMember v scope)]
		# toVisit = [(n`, addVars (boundVarsInEdge (n,n`) graph) scope)
					 \\ n` <- directSuccessors n graph
					] ++ ns
		= case get n visitedMap of
			Just visitedScope = 
				if (isEmpty [ v \\ v <- visitedScope | not (isMember v scope) ]) 
					[]
					(addVars newVars (freeVarsAfter` toVisit visitedMap))
			Nothing = addVars newVars (freeVarsAfter` toVisit (put n scope visitedMap))

freeVarsInNode :: TreeGraphNode -> Vars
freeVarsInNode (TGNode node) = mergeVars (map freeVarsInExpression node.GNode.actualParams) 
freeVarsInNode (TGSubgraph (TreeGraph graph source sink)) = freeVarsAfter graph source

freeVarsInExpression :: GExpression -> Vars
freeVarsInExpression GUndefinedExpression = emptyVars
freeVarsInExpression (GGraphExpression graph)
	# result = runParse (toTreeGraph graph)
	| isParseError result = emptyVars
	# (TreeGraph graph` source sink) = getParseSuccess result
	= freeVarsAfter graph` source
freeVarsInExpression (GListExpression items) = mergeVars (map freeVarsInExpression items)
freeVarsInExpression (GListComprehensionExpression { GListComprehension | output, input, guard} )
	= mergeVars	[ freeVarsInExpression output
				, freeVarsInExpression input
				, case guard of
				  	Just g = freeVarsInCleanExpression g
				  	Nothing = emptyVars
				]
freeVarsInExpression (GCleanExpression clean) = freeVarsInCleanExpression clean

boundVarsBefore :: (Graph TreeGraphNode GEdge) EdgeIndex -> Vars
boundVarsBefore graph startEdge = boundVarsBefore` [startEdge] []
where
	boundVarsBefore` :: [EdgeIndex] [EdgeIndex] -> Vars
	boundVarsBefore` [] visited = []
	boundVarsBefore` [e:es] visited
		| isMember e visited = boundVarsBefore` es visited
		# preds = directPredecessors (fst e) graph
		= addVars 
			(boundVarsInEdge e graph)
			(boundVarsBefore` ([(p,fst e) \\ p <- preds] ++ es) [e:visited])

boundVarsInEdge :: EdgeIndex (Graph TreeGraphNode GEdge) -> Vars
boundVarsInEdge edgeIndex graph
	# edgeData = fromJust (getEdgeData edgeIndex graph)
	= case edgeData.GEdge.pattern of
		Just p = freeVarsInCleanExpression p
		Nothing = 
			//Check for bound vars in preceding let-node
			case fromJust (getNodeData (fst edgeIndex) graph) of
			TGNode { GNode | name = "let", actualParams } = freeVarsInExpression (actualParams !! 0)
			_ = emptyVars

freeVarsInCleanExpression :: !String -> Vars
freeVarsInCleanExpression input
# mExpr = parseExpressionUnsafe input
| isNothing mExpr = []
= freeVars emptyScope (fromJust mExpr) 
where
	freeVars :: Scope ParsedExpr -> Vars
	freeVars scope (PE_List exprs) = mergeVars (map (freeVars scope) exprs)
	freeVars scope (PE_Ident ident) = if (inScope ident.id_name scope) [] [ident.id_name]
	freeVars scope (PE_Basic _) = []
//	freeVars scope (PE_Bound boundExpr) = abort "freeVars PE_Bound"
//	freeVars scope (PE_Lambda _ pat exp _) = abort "freeVars PE_Lambda"
	freeVars scope (PE_Tuple exprs) = flatten (map (freeVars scope) exprs)
//	freeVars scope (PE_Record expr optionalRecordName fieldAssignments) = abort "freeVars PE_Record"
//	freeVars scope (PE_ArrayPattern elemAssignments) = abort "freeVars PE_UpdateComprehension"
//	freeVars scope (PE_UpdateComprehension expr1 expr2 expr3 qualifiers) = abort "freeVars PE_ArrayDenot"
//	freeVars scope (PE_ArrayDenot kind exprs) = abort "freeVars PE_ArrayDenot"
	freeVars scope (PE_Selection _ expr selections) = freeVars scope expr
//	freeVars scope (PE_Update expr1 selections expr2) = abort "freeVars PE_Update"
//	freeVars scope (PE_Case _ e alts) = abort "freeVars PE_Case"
	freeVars scope (PE_If _ b e1 e2) = mergeVars [freeVars scope e \\ e <- [b,e1,e2]]
//	freeVars scope (PE_Let b defs expr) = abort "freeVars PE_Let"
//	freeVars scope (PE_ListCompr /*predef_cons_index:*/ i1 /*predef_nil_index:*/ i2 expr qualifiers) = abort "freeVars PE_ListCompr"
//	freeVars scope (PE_ArrayCompr arrayKind expr qualifiers) = abort "freeVars PE_ArrayCompr"
//	freeVars scope (PE_Sequ sequence) = abort "freeVars PE_Sequ"
//	freeVars scope (PE_WildCard) = abort "freeVars PE_Wildcard"
//	freeVars scope (PE_Field expr globalFieldSymbol /* Auxiliary, used during checking */) = abort "freeVars PE_Field"
//	freeVars scope (PE_QualifiedIdent ident string) = abort "freeVars PE_QualifiedIdent"
//	freeVars scope (PE_ABC_Code abc b) = abort "freeVars PE_ABC_Code"
//	freeVars scope (PE_Any_Code binding ident strings) = abort "freeVars PE_Any_Code"
//	freeVars scope (PE_DynamicPattern expr dyntype) = abort "freeVars PE_DynamicPattern"
//	freeVars scope (PE_Dynamic expr dyntype) = abort "freeVars PE_Dynamic"
//	freeVars scope (PE_Generic ident kind /* AA: For generics, kind indexed identifier */) = abort "freeVars PE_Generic"
//	freeVars scope (PE_TypeSignature arrayKind expr) = abort "freeVars PE_TypeSignature"
//	freeVars scope (PE_Empty) = abort "freeVars PE_Empty"
//	freeVars scope _ = abort "freeVars: not yet implemented"
	freeVars scope _ = []

//--------------------------------------------------------------------------------------------------
//Utilities

foldl1 :: (a a -> a) [a] -> a
foldl1 f [x:xs]  =  foldl f x xs

unwords :: [String] -> String
unwords [] = ""
unwords [x] = x
unwords [x:xs] = x +++ " " +++ unwords xs