implementation module Let import StdList, StdFunc, StdTuple, StdBool import SaplStruct from Set import qualified newSet, fromList, toList, member, difference, insert, filter, delete, null from Set import :: Set from 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) ![SaplLetDef] -> (!Set (SaplVar,SaplVar), !Set SaplVar) genGraph binds defs = foldl (\s (SaplLetDef bv body) -> gen binds bv s body) ('Set'.newSet,binds) defs where gen vs bv s (SApplication f as) = foldl (gen vs bv) s [SVar f:as] gen vs bv (es,is) (SVar v) | 'Set'.member v vs && v <> bv = ('Set'.insert (bv, v) es, 'Set'.delete v is) gen _ _ s _ = s // Kahn, Arthur B. (1962), "Topological sorting of large networks" sortBindings :: ![SaplLetDef] -> Maybe [SaplLetDef] sortBindings [d] = Just [d] sortBindings defs # (redges,rordbinds) = gen edges ('Set'.toList startnodes) | 'Set'.null redges = Just (map (\k -> fromJust ('Map'.get k defmap)) (reverse rordbinds)) = Nothing where (edges, startnodes) = genGraph binds defs binds = 'Set'.fromList (map (toNormalVar o unpackBindVar) defs) defmap = 'Map'.fromList (map (\d=:(SaplLetDef bv body) -> (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) ('Set'.toList edges) peredge (edges,out) e=:(n,m) # edges = 'Set'.delete e edges | 'Set'.null ('Set'.filter (\e = snd e == m) edges) = (edges, [m:out]) = (edges, out)