Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
curry
curry-tools
Commits
173fa0fb
Commit
173fa0fb
authored
May 10, 2013
by
Michael Hanus
Browse files
CASS (partially) integrated into CurryBrowser
parent
e3e82257
Changes
7
Hide whitespace changes
Inline
Side-by-side
CASS/Analysis.curry
View file @
173fa0fb
...
...
@@ -10,7 +10,7 @@
--- (instead of the data constructors).
---
--- @author Heiko Hoffmann, Michael Hanus
--- @version Ma
rch
2013
--- @version Ma
y
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
...
...
CASS/AnalysisCollection.curry
View file @
173fa0fb
...
...
@@ -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 =
[
s
cAnalysis overlapAnalysis showOverlap
,
s
cAnalysis nondetAnalysis showDet
,
s
cAnalysis rlinAnalysis showRightLinear
,
s
cAnalysis solcompAnalysis showSolComplete
,
s
cAnalysis patCompAnalysis showComplete
,
s
cAnalysis totalAnalysis showTotally
,
s
cAnalysis indetAnalysis showIndet
,
s
cAnalysis demandAnalysis showDemand
,
s
cAnalysis hiOrdType showOrder
,
s
cAnalysis hiOrdCons showOrder
,
s
cAnalysis hiOrdFunc show
,
s
cAnalysis siblingCons show
[c
ass
Analysis
"Overlapping rules"
overlapAnalysis showOverlap
,c
ass
Analysis
"Deterministic operations"
nondetAnalysis showDet
,c
ass
Analysis
"Right-linear operations"
rlinAnalysis showRightLinear
,c
ass
Analysis
"Solution completeness"
solcompAnalysis showSolComplete
,c
ass
Analysis
"Pattern completeness"
patCompAnalysis showComplete
,c
ass
Analysis
"Totally defined operations"
totalAnalysis showTotally
,c
ass
Analysis
"Indeterministic operations"
indetAnalysis showIndet
,c
ass
Analysis
"Demanded arguments"
demandAnalysis showDemand
,c
ass
Analysis
"Higher-order datatypes"
hiOrdType showOrder
,c
ass
Analysis
"Higher-order constructors"
hiOrdCons showOrder
,c
ass
Analysis
"Higher-order functions"
hiOrdFunc show
,c
ass
Analysis
"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 =
...
...
CASS/AnalysisServer.curry
View file @
173fa0fb
...
...
@@ -302,5 +302,5 @@ parseServerMessage message = case words message of
showAnalysisNamesAndFormats :: String
showAnalysisNamesAndFormats =
unlines (concatMap (\an -> map ((an++" ")++) serverFormats)
(map (\ (an,_,_) -> an) a
nalysis
Info
s)
)
registeredA
nalysis
Name
s)
CASS/Protocol.txt
View file @
173fa0fb
...
...
@@ -5,7 +5,7 @@ Server commands:
----------------
GetAnalysis
SetCurryPath <dir1>:<dir2>:...
StopSever
StopSe
r
ver
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>
...
...
browser/BrowserGUI.curry
View file @
173fa0fb
...
...
@@ -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 =
Fals
e
showExecTime =
Tru
e
---------------------------------------------------------------------
-- Title and version
title = "CurryBrowser"
version = "Version of 0
4
/0
4
/2013"
version = "Version of 0
3
/0
5
/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
...
...
browser/Makefile
View file @
173fa0fb
...
...
@@ -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
)
...
...
browser/README
View file @
173fa0fb
...
...
@@ -12,7 +12,7 @@ they have no effect.
Developed by
Michael Hanus (CAU Kiel, Germany, mh@informatik.uni-kiel.de)
Version of 0
4
/0
4
/2013
Version of 0
3
/0
5
/2013
Software requirements:
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment