CASS (partially) integrated into CurryBrowser

CASS/Analysis.curry

@@ -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

CASS/AnalysisCollection.curry

@@ -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 =

CASS/AnalysisServer.curry

@@ -302,5 +302,5 @@ parseServerMessage message = case words message of
 showAnalysisNamesAndFormats :: String
 showAnalysisNamesAndFormats =
   unlines (concatMap (\an -> map ((an++" ")++) serverFormats)
-                     (map (\ (an,_,_) -> an) analysisInfos))
+                     registeredAnalysisNames)
 

CASS/Protocol.txt

@@ -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>

browser/BrowserGUI.curry

@@ -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

browser/Makefile

@@ -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

@@ -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: