reporting of performance (time, time p step)

Author: atzedijkstra

chr-core/chr-core.cabal

@@ -51,6 +51,6 @@ library
     -- fclabels >= 2.0.3,
     chr-data >= 0.1.0.0,
     chr-pretty >= 0.1.0.0,
-    logict-state >= 0.1.0.2
+    logict-state >= 0.1.0.4
   hs-source-dirs:      src
   default-language:    Haskell2010

chr-core/src/CHR/Solve/MonoBacktrackPrio.hs

@@ -25,6 +25,7 @@ module CHR.Solve.MonoBacktrackPrio
   , CHRGlobState(..)
   , emptyCHRGlobState
   , chrgstVarToNmMp
+  , chrgstStatNrSolveSteps
 
   , CHRBackState(..)
   , emptyCHRBackState
@@ -649,8 +650,8 @@ runCHRMonoBacktrackPrioT
      -> CHRBackState cnstr bprio subst env
      -- -> CHRPrioEvaluatableVal bprio
      -> CHRMonoBacktrackPrioT cnstr guard bprio prio subst env m (SolverResult subst)
-     -> m [SolverResult subst]
-runCHRMonoBacktrackPrioT gs bs {- bp -} m = observeAllT (gs, bs {- _chrbstBacktrackPrio=bp -}) m
+     -> m ([SolverResult subst], (CHRGlobState cnstr guard bprio prio subst env m, CHRBackState cnstr bprio subst env))
+runCHRMonoBacktrackPrioT gs bs {- bp -} m = observeStateAllT (gs, bs {- _chrbstBacktrackPrio=bp -}) m
 
 -------------------------------------------------------------------------------------------
 --- Solver: Intermediate structures
@@ -787,13 +788,13 @@ defaultCHRSolveOpts
 -------------------------------------------------------------------------------------------
 
 {-# INLINABLE chrSolve #-}
-{-# SPECIALIZE chrSolve
+{- # SPECIALIZE chrSolve
   :: ( MonoBacktrackPrio c g bp p s e IO
      , PP s
      ) => CHRSolveOpts
        -> e
        -> CHRMonoBacktrackPrioT c g bp p s e IO (SolverResult s)
-  #-}
+  # -}
 -- | (Under dev) solve
 chrSolve
   :: forall c g bp p s e m .

chr-lang/src/CHR/Language/Examples/Term/Run.hs

@@ -9,6 +9,8 @@ module CHR.Language.Examples.Term.Run
 import           Data.Maybe
 import           System.IO
 import           Data.Time.Clock.POSIX
+import           Data.Time.Clock.System
+import           Data.Time.Clock.TAI
 import           Control.Monad
 import           Control.Monad.IO.Class
 import           Control.Monad.State.Class
@@ -89,10 +91,17 @@ runFile runopts f = do
                     liftIO $ putStrLn $ "Written visualization as " ++ fileName
                 else (return ())
               return r
-        runCHRMonoBacktrackPrioT (chrgstVarToNmMp ^= Lk.inverse (flip (,)) varToNmMp $ emptyCHRGlobState) (emptyCHRBackState {- _chrbstBacktrackPrio=0 -}) {- 0 -} mbp
+        tBef <- getSystemTime 
+        (_,(gs,_)) <- runCHRMonoBacktrackPrioT
+          (chrgstVarToNmMp ^= Lk.inverse (flip (,)) varToNmMp $ emptyCHRGlobState)
+          (emptyCHRBackState {- _chrbstBacktrackPrio=0 -}) {- 0 -}
+          mbp
+        tAft <- getSystemTime
+        let tDif = systemToTAITime tAft `diffAbsoluteTime` systemToTAITime tBef
+            nSteps = gs ^. MBP.chrgstStatNrSolveSteps
 
         -- done
-        msg $ "DONE " ++ f
+        msg $ "DONE (" ++ show tDif ++ " / " ++ show nSteps ++ " = " ++ show (tDif / fromIntegral nSteps) ++ ") " ++ f
 
   where
     msg m = putStrLn $ "---------------- " ++ m ++ " ----------------"