From a995c064a6fd94c767ec3c8e48c2a9bc98d65aba Mon Sep 17 00:00:00 2001
From: Laszlo Domoszlai <l.domoszlai@science.ru.nl>
Date: Mon, 2 May 2016 15:42:27 +0200
Subject: [PATCH] add missing files

---
 src/Sapl/Transform/TailRecursion.dcl |  7 ++++
 src/Sapl/Transform/TailRecursion.icl | 56 ++++++++++++++++++++++++++++
 2 files changed, 63 insertions(+)
 create mode 100644 src/Sapl/Transform/TailRecursion.dcl
 create mode 100644 src/Sapl/Transform/TailRecursion.icl

diff --git a/src/Sapl/Transform/TailRecursion.dcl b/src/Sapl/Transform/TailRecursion.dcl
new file mode 100644
index 0000000..0ced117
--- /dev/null
+++ b/src/Sapl/Transform/TailRecursion.dcl
@@ -0,0 +1,7 @@
+definition module Sapl.Transform.TailRecursion
+
+import Data.Maybe
+from Sapl.SaplStruct import :: SaplTypedVar, :: SaplTerm
+
+// Topological sort of the let definitions. Returns Nothing if a cycle is detected
+sortSetters :: ![(SaplTypedVar, SaplTerm)] -> Maybe [(SaplTypedVar, SaplTerm)]
diff --git a/src/Sapl/Transform/TailRecursion.icl b/src/Sapl/Transform/TailRecursion.icl
new file mode 100644
index 0000000..68f6cda
--- /dev/null
+++ b/src/Sapl/Transform/TailRecursion.icl
@@ -0,0 +1,56 @@
+implementation module Sapl.Transform.TailRecursion
+
+import StdList, StdFunc, StdTuple, StdBool
+import Sapl.SaplStruct
+
+from Data.Set import qualified newSet, fromList, toList, member, difference, insert, filter, delete, null
+from Data.Set import :: Set
+from Data.Map import qualified fromList, get
+
+instance == SaplVar
+where
+	(==) a b = eqVarByNameLevel a b
+
+instance < SaplVar
+where
+	(<) a b = ltVarByNameLevel a b
+
+// Generate the graph: edges and the start nodes (independent nodes)
+genGraph :: !(Set SaplVar) ![(SaplTypedVar, SaplTerm)] -> (!Set (SaplVar,SaplVar), !Set SaplVar)
+genGraph binds defs = foldl (\s (TypedVar bv _, body) -> gen binds bv s body) ('Data.Set'.newSet,binds) defs
+where
+	gen vs bv s (SSelect expr _ idx) = gen vs bv s expr
+	gen vs bv s (SUpdate expr _ updates) = foldl (gen vs bv) (gen vs bv s expr) (map snd updates)
+	gen vs bv s (SApplication (SVar f) as) = foldl (gen vs bv) s [SVar f:as]
+	gen vs bv s (SApplication expr as) = foldl (gen vs bv) (gen vs bv s expr) as
+	gen vs bv (es,is) (SVar v) 
+		| 'Data.Set'.member v vs && v <> bv  = ('Data.Set'.insert (bv, v) es, 'Data.Set'.delete v is)
+	gen _ _ s _ = s
+
+// Kahn, Arthur B. (1962), "Topological sorting of large networks"
+sortSetters :: ![(SaplTypedVar, SaplTerm)] -> Maybe [(SaplTypedVar, SaplTerm)]
+sortSetters [d] = Just [d]
+sortSetters defs 
+	# (redges,rordbinds) = gen edges ('Data.Set'.toList startnodes)
+	| 'Data.Set'.null redges
+		= Just (map (\k -> fromJust ('Data.Map'.get k defmap)) (reverse rordbinds))
+		= Nothing // cycle is detected
+where
+	(edges, startnodes) = genGraph binds defs 
+	binds  = 'Data.Set'.fromList (map (removeTypeInfo o toNormalVar o fst) defs)
+	defmap = 'Data.Map'.fromList (map (\d=:(bv, body) -> (removeTypeInfo bv,d)) defs)	
+
+	// Returns the renaming edges (if any) and the ordered list of bind vars (reversed order)
+	gen edges [] = (edges, [])
+	gen edges [n:ns] = let (redges,rout) = gen nedges (nns++ns) in (redges,[n:rout])
+	where
+		(nedges, nns) = foldl peredge (edges,[]) outedges
+		outedges = filter (\e = fst e == n) ('Data.Set'.toList edges)
+		
+		peredge (edges,out) e=:(n,m)
+			# edges = 'Data.Set'.delete e edges
+			| 'Data.Set'.null ('Data.Set'.filter (\e = snd e == m) edges)
+				= (edges, [m:out])
+				= (edges, out)
+				
+				
\ No newline at end of file
-- 
GitLab