Commit a995c064 authored by Laszlo Domoszlai's avatar Laszlo Domoszlai

add missing files

parent 074e8d03
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)]
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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment