@@ -103,14 +103,14 @@ respond stateVar =
103103 | isJust req. stepTimeout -> pure $ Left $ RpcError. unsupportedOption (" step-timeout" :: String )
104104 | isJust req. movingAverageStepTimeout ->
105105 pure $ Left $ RpcError. unsupportedOption (" moving-average-step-timeout" :: String )
106- RpcTypes. Execute req -> withModule req. _module $ \ (def, mLlvmLibrary, mSMTOptions) -> Booster.Log. withContext " execute " $ do
106+ RpcTypes. Execute req -> withModule req. _module $ \ (def, mLlvmLibrary, mSMTOptions) -> Booster.Log. withContext CtxExecute $ do
107107 start <- liftIO $ getTime Monotonic
108108 -- internalise given constrained term
109109 let internalised = runExcept $ internalisePattern DisallowAlias CheckSubsorts Nothing def req. state. term
110110
111111 case internalised of
112112 Left patternError -> do
113- void $ Booster.Log. withContext " internalise " $ logPatternError patternError
113+ void $ Booster.Log. withContext CtxInternalise $ logPatternError patternError
114114 pure $
115115 Left $
116116 RpcError. backendError $
@@ -152,7 +152,7 @@ respond stateVar =
152152 fromIntegral (toNanoSecs (diffTimeSpec stop start)) / 1e9
153153 else Nothing
154154 pure $ execResponse duration req result substitution unsupported
155- RpcTypes. AddModule RpcTypes. AddModuleRequest {_module, nameAsId = nameAsId'} -> Booster.Log. withContext " add-module " $ runExceptT $ do
155+ RpcTypes. AddModule RpcTypes. AddModuleRequest {_module, nameAsId = nameAsId'} -> Booster.Log. withContext CtxAddModule $ runExceptT $ do
156156 -- block other request executions while modifying the server state
157157 state <- liftIO $ takeMVar stateVar
158158 let nameAsId = fromMaybe False nameAsId'
@@ -213,7 +213,7 @@ respond stateVar =
213213 Booster.Log. logMessage $
214214 " Added a new module. Now in scope: " <> Text. intercalate " , " (Map. keys newDefinitions)
215215 pure $ RpcTypes. AddModule $ RpcTypes. AddModuleResult moduleHash
216- RpcTypes. Simplify req -> withModule req. _module $ \ (def, mLlvmLibrary, mSMTOptions) -> Booster.Log. withContext " simplify " $ do
216+ RpcTypes. Simplify req -> withModule req. _module $ \ (def, mLlvmLibrary, mSMTOptions) -> Booster.Log. withContext CtxSimplify $ do
217217 start <- liftIO $ getTime Monotonic
218218 let internalised =
219219 runExcept $ internaliseTermOrPredicate DisallowAlias CheckSubsorts Nothing def req. state. term
@@ -228,7 +228,7 @@ respond stateVar =
228228 result <- case internalised of
229229 Left patternErrors -> do
230230 forM_ patternErrors $ \ patternError ->
231- void $ Booster.Log. withContext " internalise " $ logPatternError patternError
231+ void $ Booster.Log. withContext CtxInternalise $ logPatternError patternError
232232 pure $
233233 Left $
234234 RpcError. backendError $
@@ -273,7 +273,7 @@ respond stateVar =
273273 logMessage (" ignoring unsupported predicate parts" :: Text )
274274 -- apply the given substitution before doing anything else
275275 let predicates = map (substituteInPredicate ps. substitution) $ Set. toList ps. boolPredicates
276- withContext " constraint " $
276+ withContext CtxConstraint $
277277 ApplyEquations. simplifyConstraints
278278 def
279279 mLlvmLibrary
@@ -305,7 +305,7 @@ respond stateVar =
305305 pure $ second mkSimplifyResponse result
306306 RpcTypes. GetModel req -> withModule req. _module $ \ case
307307 (_, _, Nothing ) -> do
308- withContext " get-model " $
308+ withContext CtxGetModel $
309309 logMessage' (" get-model request, not supported without SMT solver" :: Text )
310310 pure $ Left RpcError. notImplemented
311311 (def, _, Just smtOptions) -> do
@@ -315,7 +315,7 @@ respond stateVar =
315315 case internalised of
316316 Left patternErrors -> do
317317 forM_ patternErrors $ \ patternError ->
318- void $ Booster.Log. withContext " internalise " $ logPatternError patternError
318+ void $ Booster.Log. withContext CtxInternalise $ logPatternError patternError
319319 pure $
320320 Left $
321321 RpcError. backendError $
@@ -327,20 +327,20 @@ respond stateVar =
327327 (boolPs, suppliedSubst) <-
328328 case things of
329329 TermAndPredicates pat substitution unsupported -> do
330- withContext " get-model " $
330+ withContext CtxGetModel $
331331 logMessage' (" ignoring supplied terms and only checking predicates" :: Text )
332332
333333 unless (null unsupported) $ do
334- withContext " get-model " $ do
334+ withContext CtxGetModel $ do
335335 logMessage' (" ignoring unsupported predicates" :: Text )
336- withContext " detail " $
336+ withContext CtxDetail $
337337 logMessage (Text. unwords $ map prettyPattern unsupported)
338338 pure (Set. toList pat. constraints, substitution)
339339 Predicates ps -> do
340340 unless (null ps. ceilPredicates && null ps. unsupported) $ do
341- withContext " get-model " $ do
341+ withContext CtxGetModel $ do
342342 logMessage' (" ignoring supplied ceils and unsupported predicates" :: Text )
343- withContext " detail " $
343+ withContext CtxDetail $
344344 logMessage
345345 ( Text. unlines $
346346 map
@@ -354,8 +354,8 @@ respond stateVar =
354354 if null boolPs && Map. null suppliedSubst
355355 then do
356356 -- as per spec, no predicate, no answer
357- withContext " get-model " $
358- withContext " smt " $
357+ withContext CtxGetModel $
358+ withContext CtxSMT $
359359 logMessage (" No predicates or substitutions given, returning Unknown" :: Text )
360360 pure $ Left SMT. Unknown
361361 else do
@@ -365,8 +365,8 @@ respond stateVar =
365365 case result of
366366 Left err -> liftIO $ Exception. throw err -- fail hard on SMT errors
367367 Right response -> pure response
368- withContext " get-model " $
369- withContext " smt " $
368+ withContext CtxGetModel $
369+ withContext CtxSMT $
370370 logMessage $
371371 " SMT result: " <> pack (either show ((" Subst: " <> ) . show . Map. size) smtResult)
372372 pure . Right . RpcTypes. GetModel $ case smtResult of
@@ -413,22 +413,22 @@ respond stateVar =
413413 { satisfiable = RpcTypes. Sat
414414 , substitution
415415 }
416- RpcTypes. Implies req -> withModule req. _module $ \ (def, mLlvmLibrary, mSMTOptions) -> Booster.Log. withContext " implies " $ do
416+ RpcTypes. Implies req -> withModule req. _module $ \ (def, mLlvmLibrary, mSMTOptions) -> Booster.Log. withContext CtxImplies $ do
417417 -- internalise given constrained term
418418 let internalised =
419419 runExcept . internalisePattern DisallowAlias CheckSubsorts Nothing def . fst . extractExistentials
420420
421421 case (internalised req. antecedent. term, internalised req. consequent. term) of
422422 (Left patternError, _) -> do
423- void $ Booster.Log. withContext " internalise " $ logPatternError patternError
423+ void $ Booster.Log. withContext CtxInternalise $ logPatternError patternError
424424 pure $
425425 Left $
426426 RpcError. backendError $
427427 RpcError. CouldNotVerifyPattern
428428 [ patternErrorToRpcError patternError
429429 ]
430430 (_, Left patternError) -> do
431- void $ Booster.Log. withContext " internalise " $ logPatternError patternError
431+ void $ Booster.Log. withContext CtxInternalise $ logPatternError patternError
432432 pure $
433433 Left $
434434 RpcError. backendError $
@@ -440,11 +440,11 @@ respond stateVar =
440440 logMessage'
441441 (" aborting due to unsupported predicate parts" :: Text )
442442 unless (null unsupportedL) $
443- withContext " detail " $
443+ withContext CtxDetail $
444444 logMessage
445445 (Text. unwords $ map prettyPattern unsupportedL)
446446 unless (null unsupportedR) $
447- withContext " detail " $
447+ withContext CtxDetail $
448448 logMessage
449449 (Text. unwords $ map prettyPattern unsupportedR)
450450 let
0 commit comments