Commit 57c4a952 authored by Michael Hanus's avatar Michael Hanus
Browse files

Imports updated

parent e88e798e
Pipeline #347 failed with stages
{
"name": "nonstrictunif-optimize",
"version": "0.0.1",
"version": "2.0.0",
"author": "Michael Hanus <mh@informatik.uni-kiel.de>",
"synopsis": "Linearity optimizer for functional patterns",
"category": [ "Optimization" ],
"license": "BSD-3-Clause",
"licenseFile": "LICENSE",
"dependencies": {
"flatcurry": ">= 0.0.1"
"flatcurry" : ">= 0.0.1",
"redblacktree" : ">= 0.0.1"
},
"compilerCompatibility": {
"pakcs": ">= 1.14.0, < 2.0.0",
"kics2": ">= 0.5.0, < 2.0.0"
"pakcs": ">= 2.0.0",
"kics2": ">= 2.0.0"
},
"executable": {
"name": "curry-nonstrictopt",
......
-----------------------------------------------------------------------------
-- A few base functions for analysing dependencies in FlatCurry programs:
--
-- Michael Hanus, June 2005
-- Michael Hanus, December 2018
-----------------------------------------------------------------------------
module CurryBrowseAnalysis.Dependency
......@@ -9,11 +9,11 @@ module CurryBrowseAnalysis.Dependency
funcsInExpr, callsDirectly, externalDependent,
dependencyGraphs, localDependencyGraphs) where
import FlatCurry.Types
import List
import SetRBT
import Sort(leqString)
import Maybe(fromJust)
import Sort(leqString)
import Data.Set.RBTree ( SetRBT, member, empty, insert, toList, union )
import FlatCurry.Types
-- Generic global function analysis where the property of each function is a combination
-- of a property of the function and all its dependent functions.
......@@ -51,12 +51,12 @@ externalDependent funcs =
-- Result: a list of pairs of qualified functions names and the corresponding
-- called functions
indirectlyDependent :: [FuncDecl] -> [(QName,[QName])]
indirectlyDependent funs = map (\ (f,ds) -> (f,setRBT2list ds))
indirectlyDependent funs = map (\ (f,ds) -> (f,toList ds))
(depsClosure (map directlyDependent funs))
-- list of direct dependencies for a function
callsDirectly :: FuncDecl -> [QName]
callsDirectly fun = setRBT2list (snd (directlyDependent fun))
callsDirectly fun = toList (snd (directlyDependent fun))
-- set of direct dependencies for a function
directlyDependent :: FuncDecl -> (QName,SetRBT QName)
......@@ -66,14 +66,14 @@ directlyDependent (Func f _ _ _ (External _)) = (f,emptySet)
-- compute the transitive closure of all dependencies based on a list of
-- direct dependencies:
depsClosure :: [(QName,SetRBT QName)] -> [(QName,SetRBT QName)]
depsClosure directdeps = map (\(f,ds)->(f,closure ds (setRBT2list ds)))
depsClosure directdeps = map (\(f,ds)->(f,closure ds (toList ds)))
directdeps
where
closure olddeps [] = olddeps
closure olddeps (f:fs) =
let newdeps = filter (\e->not (elemRBT e olddeps))
(setRBT2list (maybe emptySet id (lookup f directdeps)))
in closure (foldr insertRBT olddeps newdeps) (newdeps++fs)
let newdeps = filter (\e->not (member e olddeps))
(toList (maybe emptySet id (lookup f directdeps)))
in closure (foldr insert olddeps newdeps) (newdeps++fs)
-- Computes the list of all direct dependencies for all functions.
-- This is useful to represent the dependency graph for each function.
......@@ -83,8 +83,8 @@ depsClosure directdeps = map (\(f,ds)->(f,closure ds (setRBT2list ds)))
dependencyGraphs :: [FuncDecl] -> [(QName,[(QName,[QName])])]
dependencyGraphs funs =
let directdeps = map directlyDependent funs
in map (\(f,ds) -> (f,map (\g->(g,setRBT2list (fromJust (lookup g directdeps))))
(setRBT2list (insertRBT f ds))))
in map (\(f,ds) -> (f,map (\g->(g,toList (fromJust (lookup g directdeps))))
(toList (insert f ds))))
(depsClosure directdeps)
-- Computes for all functions the list of all direct local dependencies, i.e.,
......@@ -98,29 +98,29 @@ localDependencyGraphs :: [FuncDecl] -> [(QName,[(QName,[QName])])]
localDependencyGraphs funs =
let directdeps = map directlyDependent funs
in map (\(f,ds) -> (f,map (\g->(g,if fst f == fst g
then setRBT2list (fromJust (lookup g directdeps))
then toList (fromJust (lookup g directdeps))
else []))
(setRBT2list (insertRBT f ds))))
(toList (insert f ds))))
(localDepsClosure directdeps)
-- compute the transitive closure of all local dependencies based on a list of
-- direct dependencies:
localDepsClosure :: [(QName,SetRBT QName)] -> [(QName,SetRBT QName)]
localDepsClosure directdeps =
map (\(f,ds)->(f,closure (fst f) ds (setRBT2list ds))) directdeps
map (\(f,ds)->(f,closure (fst f) ds (toList ds))) directdeps
where
closure _ olddeps [] = olddeps
closure mod olddeps (f:fs)
| mod == fst f -- f is local in this module: add dependencies
= let newdeps = filter (\e->not (elemRBT e olddeps))
(setRBT2list (maybe emptySet id (lookup f directdeps)))
in closure mod (foldr insertRBT olddeps newdeps) (newdeps++fs)
= let newdeps = filter (\e->not (member e olddeps))
(toList (maybe emptySet id (lookup f directdeps)))
in closure mod (foldr insert olddeps newdeps) (newdeps++fs)
| otherwise = closure mod olddeps fs
-- Gets a list of all functions (including partially applied functions)
-- called in an expression:
funcsInExpr :: Expr -> [QName]
funcsInExpr e = setRBT2list (funcSetOfExpr e)
funcsInExpr e = toList (funcSetOfExpr e)
-- Gets the set of all functions (including partially applied functions)
-- called in an expression:
......@@ -129,11 +129,11 @@ funcSetOfExpr (Var _) = emptySet
funcSetOfExpr (Lit _) = emptySet
funcSetOfExpr (Comb ct f es) =
if isConstructorComb ct then unionMap funcSetOfExpr es
else insertRBT f (unionMap funcSetOfExpr es)
else insert f (unionMap funcSetOfExpr es)
funcSetOfExpr (Free _ e) = funcSetOfExpr e
funcSetOfExpr (Let bs e) = unionRBT (unionMap (funcSetOfExpr . snd) bs) (funcSetOfExpr e)
funcSetOfExpr (Or e1 e2) = unionRBT (funcSetOfExpr e1) (funcSetOfExpr e2)
funcSetOfExpr (Case _ e bs) = unionRBT (funcSetOfExpr e) (unionMap funcSetOfBranch bs)
funcSetOfExpr (Let bs e) = union (unionMap (funcSetOfExpr . snd) bs) (funcSetOfExpr e)
funcSetOfExpr (Or e1 e2) = union (funcSetOfExpr e1) (funcSetOfExpr e2)
funcSetOfExpr (Case _ e bs) = union (funcSetOfExpr e) (unionMap funcSetOfBranch bs)
where funcSetOfBranch (Branch _ be) = funcSetOfExpr be
funcSetOfExpr (Typed e _) = funcSetOfExpr e
......@@ -144,10 +144,10 @@ isConstructorComb ct = case ct of
_ -> False
unionMap :: (a -> SetRBT QName) -> [a] -> SetRBT QName
unionMap f = foldr unionRBT emptySet . map f
unionMap f = foldr union emptySet . map f
emptySet :: SetRBT QName
emptySet = emptySetRBT leqQName
emptySet = empty leqQName
leqQName :: QName -> QName -> Bool
leqQName (m1,n1) (m2,n2) = leqString (m1++('.':n1)) (m2++('.':n2))
......
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