Commit ea0289bd authored by Michael Hanus 's avatar Michael Hanus

Imports updated

parent fe3c7ca9
......@@ -12,6 +12,7 @@
"currypath" : ">= 0.0.1",
"flatcurry" : ">= 2.0.0",
"propertyfile" : ">= 0.0.1",
"redblacktree" : ">= 0.0.1",
"scc" : ">= 0.0.1",
"socket" : ">= 0.0.1",
"xml" : ">= 2.0.0"
......
......@@ -8,8 +8,9 @@
module CASS.FlatCurryDependency(dependsDirectlyOnTypes,callsDirectly) where
import FlatCurry.Types
import List
import SetRBT
import List ( nub )
import Data.Set.RBTree ( SetRBT, empty, insert, toList, union)
--- Return the type constructors occurring in a type declaration.
dependsDirectlyOnTypes :: TypeDecl -> [QName]
......@@ -31,7 +32,7 @@ tconsOf (ForallType _ te) = tconsOf te
-----------------------------------------------------------------------------
-- 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)
......@@ -45,12 +46,12 @@ 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 (Let bs e) = union (unionMap (funcSetOfExpr . snd) bs)
(funcSetOfExpr e)
funcSetOfExpr (Or e1 e2) = unionRBT (funcSetOfExpr e1) (funcSetOfExpr e2)
funcSetOfExpr (Case _ e bs) = unionRBT (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
......@@ -62,10 +63,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) = m1++('.':n1) <= m2++('.':n2)
......@@ -3,7 +3,7 @@
--- In particular, it contains some simple fixpoint computations.
---
--- @author Heiko Hoffmann, Michael Hanus
--- @version September 2018
--- @version December 2018
--------------------------------------------------------------------------
module CASS.WorkerFunctions where
......@@ -12,7 +12,6 @@ import FiniteMap
import IOExts
import List ( partition )
import Maybe ( fromJust )
import SetRBT
import System ( getCPUTime )
import Analysis.Files
......@@ -26,6 +25,7 @@ import FlatCurry.Types
import FlatCurry.Files
import FlatCurry.Goodies
import Data.SCC ( scc )
import Data.Set.RBTree as Set ( SetRBT, member, empty, insert, null )
import CASS.Configuration
import CASS.FlatCurryDependency ( callsDirectly, dependsDirectlyOnTypes )
......@@ -193,17 +193,17 @@ runAnalysis analysis prog importInfos startvals fpmethod = do
SimpleTypeAnalysis _ _ ->
(definedTypes, typeInfos2ProgInfo defaultTypes deflts)
SimpleConstructorAnalysis _ _ -> -- there are no external constructors
if null deflts then (prog,emptyProgInfo)
if Prelude.null deflts then (prog,emptyProgInfo)
else error "SimpleConstructorAnalysis with default values!"
DependencyFuncAnalysis _ _ _ ->
(definedFuncs, funcInfos2ProgInfo defaultFuncs deflts)
DependencyTypeAnalysis _ _ _ ->
(definedTypes, typeInfos2ProgInfo defaultTypes deflts)
SimpleModuleAnalysis _ _ ->
if null deflts then (definedFuncs, emptyProgInfo)
if Prelude.null deflts then (definedFuncs, emptyProgInfo)
else error defaultNotEmptyError
DependencyModuleAnalysis _ _ ->
if null deflts then (definedFuncs, emptyProgInfo)
if Prelude.null deflts then (definedFuncs, emptyProgInfo)
else error defaultNotEmptyError
_ -> error "Internal error in WorkerFunctions.runAnalysis"
let result = executeAnalysis analysis progWithoutDefaults
......@@ -260,7 +260,7 @@ executeAnalysis (DependencyFuncAnalysis _ _ anaFunc) prog
"wlist" ->
let declsWithDeps = map addCalledFunctions (progFuncs prog)
in funcInfos2ProgInfo prog $ fmToList $
wlIteration anaFunc funcName declsWithDeps [] (emptySetRBT (<))
wlIteration anaFunc funcName declsWithDeps [] (empty (<))
importInfos (listToFM (<) startvals)
"wlistscc" ->
let declsWithDeps = map addCalledFunctions (progFuncs prog)
......@@ -268,7 +268,7 @@ executeAnalysis (DependencyFuncAnalysis _ _ anaFunc) prog
sccDecls = scc ((:[]) . funcName . fst) snd declsWithDeps
in funcInfos2ProgInfo prog $ fmToList $
foldr (\scc sccstartvals ->
wlIteration anaFunc funcName scc [] (emptySetRBT (<))
wlIteration anaFunc funcName scc [] (empty (<))
importInfos sccstartvals)
(listToFM (<) startvals)
(reverse sccDecls)
......@@ -284,7 +284,7 @@ executeAnalysis (DependencyTypeAnalysis _ _ anaType) prog
"wlist" ->
let declsWithDeps = map addUsedTypes (progTypes prog)
in typeInfos2ProgInfo prog $ fmToList $
wlIteration anaType typeName declsWithDeps [] (emptySetRBT (<))
wlIteration anaType typeName declsWithDeps [] (empty (<))
importInfos (listToFM (<) startvals)
"wlistscc" ->
let declsWithDeps = map addUsedTypes (progTypes prog)
......@@ -292,7 +292,7 @@ executeAnalysis (DependencyTypeAnalysis _ _ anaType) prog
sccDecls = scc ((:[]) . typeName . fst) snd declsWithDeps
in typeInfos2ProgInfo prog $ fmToList $
foldr (\scc sccstartvals ->
wlIteration anaType typeName scc [] (emptySetRBT (<))
wlIteration anaType typeName scc [] (empty (<))
importInfos sccstartvals)
(listToFM (<) startvals)
(reverse sccDecls)
......@@ -359,13 +359,13 @@ wlIteration :: Eq a => (t -> [(QName,a)] -> a) -> (t -> QName)
-- importInfos currvals
wlIteration analysis nameOf [] alldecls changedEntities importInfos currvals =
if isEmptySetRBT changedEntities
if Set.null changedEntities
then currvals -- no todos, no changed values, so we are done:
else -- all declarations processed, compute todos for next round:
let (declsToDo,declsDone) =
partition (\ (_,calls) -> any (`elemRBT` changedEntities) calls)
partition (\ (_,calls) -> any (`member` changedEntities) calls)
alldecls
in wlIteration analysis nameOf declsToDo declsDone (emptySetRBT (<))
in wlIteration analysis nameOf declsToDo declsDone (empty (<))
importInfos currvals
-- process a single declaration:
wlIteration analysis nameOf (decldeps@(decl,calls):decls) declsDone
......@@ -380,7 +380,7 @@ wlIteration analysis nameOf (decldeps@(decl,calls):decls) declsDone
then wlIteration analysis nameOf decls (decldeps:declsDone)
changedEntities importInfos currvals
else wlIteration analysis nameOf decls (decldeps:declsDone)
(insertRBT decname changedEntities) importInfos
(insert decname changedEntities) importInfos
(updFM currvals decname (const newval))
......
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