Commit 173fa0fb authored by Michael Hanus 's avatar Michael Hanus
Browse files

CASS (partially) integrated into CurryBrowser

parent e3e82257
......@@ -10,7 +10,7 @@
--- (instead of the data constructors).
---
--- @author Heiko Hoffmann, Michael Hanus
--- @version March 2013
--- @version May 2013
-------------------------------------------------------------------------
module Analysis(Analysis(..),
......@@ -19,7 +19,7 @@ module Analysis(Analysis(..),
dependencyFuncAnalysis,dependencyTypeAnalysis,
combinedSimpleFuncAnalysis,combinedSimpleTypeAnalysis,
combinedDependencyFuncAnalysis,combinedDependencyTypeAnalysis,
isSimpleAnalysis,isCombinedAnalysis,
isSimpleAnalysis,isCombinedAnalysis,isFunctionAnalysis,
analysisName,baseAnalysisName,startValue)
where
......@@ -178,6 +178,16 @@ isCombinedAnalysis analysis = case analysis of
CombinedDependencyTypeAnalysis _ _ _ _ _ -> True
_ -> False
--- Is the analysis a function analysis?
--- Otherwise, it is a type or constructor analysis.
isFunctionAnalysis :: Analysis a -> Bool
isFunctionAnalysis analysis = case analysis of
SimpleFuncAnalysis _ _ -> True
DependencyFuncAnalysis _ _ _ -> True
CombinedSimpleFuncAnalysis _ _ _ _ -> True
CombinedDependencyFuncAnalysis _ _ _ _ _ -> True
_ -> False
--- Name of the analysis to be used in server communication and
--- analysis files.
analysisName :: Analysis a -> String
......
......@@ -9,7 +9,7 @@
--------------------------------------------------------------------
module AnalysisCollection(
analysisInfos,functionAnalysisInfos,registeredAnalysisNames,
functionAnalysisInfos,registeredAnalysisNames,
lookupRegAnaWorker,runAnalysisWithWorkers,analyzeMain) where
import FlatCurry
......@@ -39,53 +39,23 @@ import TotallyDefined
import Indeterministic
import Demandedness
--- Each analysis name should be added here together with a short explanation.
--- The first component is the registered analysis name.
--- These names will be visible by the server message `GetAnalysis`.
--- The second and third components, which might be used in interactive tools
--- like the CurryBrowser, are a longer analysis name and some explanation
--- of the analysis and their result values.
analysisInfos = functionAnalysisInfos ++ typeAnalysisInfos
functionAnalysisInfos =
[("Overlapping", "Overlapping rules", "Overlapping function analysis")
,("Deterministic","Deterministic operations",
"(Non-)determinism function analysis")
,("PatComplete", "Pattern completeness", "Pattern completeness analysis")
,("Total", "Totally defined operations",
"Totally definedness analysis")
,("SolComplete", "Solution completeness","Solution completeness analysis")
,("Indeterministic","Indeterministic operations",
"Indeterminism function analysis")
,("RightLinear", "Right-linear operations","Right-linear function analysis")
,("HiOrderFunc", "Higher-order functions","Higher-order function analysis")
,("Demand", "Demanded arguments","Demanded arguments analysis")
]
typeAnalysisInfos =
[("HiOrderType", "Higher-order datatypes", "Higher-order datatype analysis")
,("HiOrderConstr","Higher-order constructors",
"Higher-order constructor analysis")
,("SiblingCons", "Sibling constructors","Sibling constructor analysis")
]
--------------------------------------------------------------------
--- Each analysis used in our tool must be registered in this list
--- together with an operation to show the analysis result as a string.
registeredAnalysis :: [RegisteredAnalysis]
registeredAnalysis =
[scAnalysis overlapAnalysis showOverlap
,scAnalysis nondetAnalysis showDet
,scAnalysis rlinAnalysis showRightLinear
,scAnalysis solcompAnalysis showSolComplete
,scAnalysis patCompAnalysis showComplete
,scAnalysis totalAnalysis showTotally
,scAnalysis indetAnalysis showIndet
,scAnalysis demandAnalysis showDemand
,scAnalysis hiOrdType showOrder
,scAnalysis hiOrdCons showOrder
,scAnalysis hiOrdFunc show
,scAnalysis siblingCons show
[cassAnalysis "Overlapping rules" overlapAnalysis showOverlap
,cassAnalysis "Deterministic operations" nondetAnalysis showDet
,cassAnalysis "Right-linear operations" rlinAnalysis showRightLinear
,cassAnalysis "Solution completeness" solcompAnalysis showSolComplete
,cassAnalysis "Pattern completeness" patCompAnalysis showComplete
,cassAnalysis "Totally defined operations" totalAnalysis showTotally
,cassAnalysis "Indeterministic operations" indetAnalysis showIndet
,cassAnalysis "Demanded arguments" demandAnalysis showDemand
,cassAnalysis "Higher-order datatypes" hiOrdType showOrder
,cassAnalysis "Higher-order constructors" hiOrdCons showOrder
,cassAnalysis "Higher-order functions" hiOrdFunc show
,cassAnalysis "Sibling constructors" siblingCons show
]
......@@ -94,28 +64,50 @@ registeredAnalysis =
-- Static part of this module follows below
--------------------------------------------------------------------
--- This auxiliary operation creates a new program analysis to be used
--- by the server/client analysis tool from a given analysis and
--- analysis show function. The first argument is a short title for the
--- analysis.
cassAnalysis :: String -> Analysis a -> (a->String) -> RegisteredAnalysis
cassAnalysis title analysis showres =
RegAna (analysisName analysis)
(isFunctionAnalysis analysis)
title
(analyzeAsString analysis showres)
(analysisClient analysis)
--- The type of all registered analysis.
--- The first component is the name of the analysis.
--- The second component is the operation used by the server
--- to distribute analysis work to the clients.
--- The third component is the worker operation to analyze a list of modules.
--- The components are as follows:
--- * the name of the analysis
--- * is this a function analysis?
--- * a long meaningful name of the analysis
--- * the operation used by the server to distribute analysis work
--- to the clients
--- * the worker operation to analyze a list of modules
data RegisteredAnalysis =
RegAna String
Bool
String
(String -> [Handle] -> Bool -> IO (Either (ProgInfo String) String))
([String] -> IO ())
regAnaName (RegAna n _ _) = n
regAnaName (RegAna n _ _ _ _) = n
regAnaServer (RegAna _ a _) = a
regAnaServer (RegAna _ _ _ a _) = a
regAnaWorker (RegAna _ _ a) = a
regAnaWorker (RegAna _ _ _ _ a) = a
--- Names of all registered analyses.
registeredAnalysisNames = map regAnaName registeredAnalysis
--- Names and titles of all registered function analyses.
functionAnalysisInfos =
map (\ (RegAna n _ t _ _) -> (n,t))
(filter (\ (RegAna _ fa _ _ _) -> fa) registeredAnalysis)
lookupRegAna :: String -> [RegisteredAnalysis] -> Maybe RegisteredAnalysis
lookupRegAna _ [] = Nothing
lookupRegAna aname (ra@(RegAna raname _ _) : ras) =
lookupRegAna aname (ra@(RegAna raname _ _ _ _) : ras) =
if aname==raname then Just ra else lookupRegAna aname ras
-- Look up a registered analysis server with a given analysis name.
......@@ -131,15 +123,6 @@ lookupRegAnaWorker :: String -> ([String] -> IO ())
lookupRegAnaWorker aname =
maybe (const done) regAnaWorker (lookupRegAna aname registeredAnalysis)
--- This auxiliary operation creates new analysis operations to be used
--- by the server/client analysis tool from a given analysis and
--- analysis show function.
scAnalysis :: Analysis a -> (a->String) -> RegisteredAnalysis
scAnalysis analysis showres =
RegAna (analysisName analysis)
(analyzeAsString analysis showres)
(analysisClient analysis)
--------------------------------------------------------------------
debugMessage dl message =
......
......@@ -302,5 +302,5 @@ parseServerMessage message = case words message of
showAnalysisNamesAndFormats :: String
showAnalysisNamesAndFormats =
unlines (concatMap (\an -> map ((an++" ")++) serverFormats)
(map (\ (an,_,_) -> an) analysisInfos))
registeredAnalysisNames)
......@@ -5,7 +5,7 @@ Server commands:
----------------
GetAnalysis
SetCurryPath <dir1>:<dir2>:...
StopSever
StopServer
AnalyzeModule <kind of analysis> <output type> <module name>
AnalyzeInterface <kind of analysis> <output type> <module name>
AnalyzeFunction <kind of analysis> <output type> <module name> <function name>
......
......@@ -3,6 +3,7 @@
--- programs.
---
--- @author Michael Hanus
--- @version May 2013
---------------------------------------------------------------------
module BrowserGUI where
......@@ -27,18 +28,21 @@ import ShowGraph
import ImportCalls
import Directory
import Time(toCalendarTime,calendarTimeToString)
import Distribution(installDir)
import Distribution(installDir,curryCompiler)
import AnalysisServer(analyzeModuleForBrowser)
import AnalysisCollection(functionAnalysisInfos)
---------------------------------------------------------------------
-- Set this constant to True if the execution times of the main operations
-- should be shown in the status line:
showExecTime = False
showExecTime = True
---------------------------------------------------------------------
-- Title and version
title = "CurryBrowser"
version = "Version of 04/04/2013"
version = "Version of 03/05/2013"
patchReadmeVersion = do
readmetxt <- readCompleteFile "README"
......@@ -299,9 +303,15 @@ browserGUI gstate rmod rtxt names =
Cmd (showBusy selmod), Background "yellow", Fill],
MenuButton
[Text "Analyze selected module...",
Menu (map (\ (aname,acmt,afun) -> MButton (showMBusy (analyzeAllFuns acmt afun))
aname)
Menu (map (\ (aname,acmt,afun) ->
MButton (showMBusy (analyzeAllFuns acmt afun)) aname)
allFunctionAnalyses)],
MenuButton
[Text "Analyze selected module with CASS...",
Menu (map (\ (aname,atitle) ->
MButton (showMBusy (analyzeAllFunsWithCASS aname atitle))
atitle)
functionAnalysisInfos)],
row [MenuButton
[Text "Select functions...",
Menu [MButton (showMBusy (executeForModule showExportedFuns))
......@@ -398,12 +408,16 @@ browserGUI gstate rmod rtxt names =
showBusy handler gp = do
setConfig rstatus (Background "red") gp
setConfig rstatus (Text "Status: running") gp
time1 <- getCPUTime
let elapsed = curryCompiler=="pakcs"
time1 <- if elapsed then getElapsedTime else getCPUTime
handler gp
time2 <- getCPUTime
setConfig rstatus (Text $ if showExecTime
then "Status: ready (" ++ show(time2-time1) ++ " msecs)"
else "Status: ready") gp
time2 <- if elapsed then getElapsedTime else getCPUTime
setConfig rstatus
(Text $ if showExecTime
then "Status: ready (" ++
(if elapsed then "elapsed time: " else "exec time: ") ++
show(time2-time1) ++ " msecs)"
else "Status: ready") gp
setConfig rstatus (Background "green") gp
showMBusy handler gp = showBusy handler gp >> return []
......@@ -608,14 +622,35 @@ browserGUI gstate rmod rtxt names =
-- analyze all functions in the function column:
analyzeAllFuns explanation analysis gp = safeIO gp $ do
mod <- getSelectedModName gp
if mod==Nothing then done else
getFunctionListKind gstate >>= \modfuns ->
(if modfuns then done else showExportedFuns (fromJust mod) gp) >>
getFuns gstate >>= \funs ->
setValue resultwidget explanation gp >>
performAllAnalysis analysis (showDoing gp) (fromJust mod) funs >>= \anaresults ->
setConfig rfun (List (map (\(prefix,func)-> prefix++" "++snd (funcName func))
(zip anaresults funs))) gp
if mod==Nothing then done else do
modfuns <- getFunctionListKind gstate
let modName = fromJust mod
if modfuns then done else showExportedFuns modName gp
funs <- getFuns gstate
setValue resultwidget explanation gp
anaresults <- performAllAnalysis analysis (showDoing gp) modName funs
setConfig rfun
(List (map (\ (prefix,func)-> prefix++" "++snd (funcName func))
(zip anaresults funs)))
gp
-- analyze all functions with Curry Analysis Server System:
analyzeAllFunsWithCASS analysisName explanation gp = safeIO gp $ do
mod <- getSelectedModName gp
if mod==Nothing then done else do
let modName = fromJust mod
modfuns <- getFunctionListKind gstate
if modfuns then done else showExportedFuns modName gp
funs <- getFuns gstate
setValue resultwidget explanation gp
showDoing gp "Analyzing..."
results <- analyzeModuleForBrowser analysisName modName
setConfig rfun
(List (map (\qf -> let info = maybe "?" id (lookup qf results)
in snd qf ++ if null info then ""
else ": "++info)
(map funcName funs)))
gp
-- Perform an analysis on a module:
performModuleAnalysis (InterfaceAnalysis ana) _ mod = do
......
......@@ -8,6 +8,8 @@ LIB=$(ROOT)/lib
META=$(LIB)/meta
TOOLS=$(ROOT)/tools
CURRYTOOLS=$(ROOT)/currytools
CASS=$(CURRYTOOLS)/CASS
ANADIR=$(CURRYTOOLS)/analysis
.PHONY: all
all: BrowserGUI SourceProgGUI
......@@ -15,13 +17,14 @@ all: BrowserGUI SourceProgGUI
# generate executable for Curry Browser:
BrowserGUI: BrowserGUI.curry ShowFlatCurry.curry Imports.curry \
AnalysisTypes.curry BrowserAnalysis.curry ShowGraph.curry \
$(CASS)/AnalysisServer.curry $(CASS)/AnalysisCollection.curry \
$(CURRYTOOLS)/addtypes/AddTypes.curry \
$(CURRYTOOLS)/importcalls/ImportCalls.curry \
$(LIB)/GUI.curry $(LIB)/IOExts.curry $(LIB)/System.curry \
$(META)/FlatCurry.curry $(META)/FlatCurryShow.curry \
analysis/*.curry
analysis/*.curry $(ANADIR)/*.curry
$(ROOT)/bin/$(CURRYSYSTEM) $(REPL_OPTS) \
:set path analysis:$(CURRYTOOLS)/importcalls:$(CURRYTOOLS)/addtypes \
:set path analysis::$(CASS):$(ANADIR):$(CURRYTOOLS)/importcalls:$(CURRYTOOLS)/addtypes \
:l BrowserGUI :eval "patchReadmeVersion" :save :q
(cd $(ROOT)/bin ; rm -f currybrowse ; \
ln -s ../currytools/browser/BrowserGUI currybrowse)
......
......@@ -12,7 +12,7 @@ they have no effect.
Developed by
Michael Hanus (CAU Kiel, Germany, mh@informatik.uni-kiel.de)
Version of 04/04/2013
Version of 03/05/2013
Software requirements:
......
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