{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable #-}-- |-- Module : Test.ChasingBottoms.TimeOut-- Copyright : (c) Nils Anders Danielsson 2004-2011-- License : See the file LICENCE.---- Maintainer : http://www.cse.chalmers.se/~nad/-- Stability : experimental-- Portability : non-portable (preemptive scheduling)---- When dealing with \"hard bottoms\", i.e. non-terminating-- computations that do not result in exceptions, the following functions-- may be handy.---- Note that a computation is considered to have terminated when it-- has reached weak head normal form (i.e. something distinct from-- bottom).moduleTest.ChasingBottoms.TimeOut(Result(..),timeOut,timeOut',timeOutMicro,timeOutMicro')whereimportControl.ConcurrentimportData.DynamicimportqualifiedControl.ExceptionasEimport{-# SOURCE #-}qualifiedTest.ChasingBottoms.IsBottomasBdataResulta=Valuea|NonTermination|ExceptionE.SomeExceptionderiving(Show,Typeable)-- | @'timeOut' n c@ runs @c@ for at most @n@ seconds (modulo-- scheduling issues).---- * If the computation terminates before that, then @'Value' v@ is-- returned, where @v@ is the resulting value. Note that this-- value may be equal to bottom, e.g. if @c = 'return'-- 'B.bottom'@.---- * If the computation does not terminate, then 'NonTermination' is-- returned.---- * If the computation raises an exception, then @'Exception' e@ is-- returned, where @e@ is the exception.---- Note that a user-defined exception is used to terminate the-- computation, so if @c@ catches all exceptions, or blocks-- asynchronous exceptions, then 'timeOut' may fail to function-- properly.timeOut::Int->IOa->IO(Resulta)timeOut=timeOutMicro.(*10^6)-- | 'timeOutMicro' takes a delay in microseconds. Note that the-- resolution is not necessarily very high (the last time I checked it-- was 0.02 seconds when using the standard runtime system settings-- for GHC).timeOutMicro::Int->IOa->IO(Resulta)timeOutMicrodelayio=domv<-newEmptyMVarletputException=putMVarmv.ExceptionioThread<-forkIO$(io>>=putMVarmv.Value)`E.catch`(\(e::E.SomeException)->caseE.fromExceptioneofJustDie->return()-- Thread properly killed.Nothing->putExceptione)reaper<-forkIO$dothreadDelaydelayputMVarmvNonTerminationresult<-takeMVarmvkillThread'ioThreadkillThreadreaperreturnresult-- Since 'ioThread' above should return exceptions raised in the code-- it seems like a bad idea to kill the thread using killThread, which-- raises @'AsyncException' 'ThreadKilled'@. We use the locally-- defined type 'Die' instead.dataDie=Diederiving(Show,Typeable)instanceE.ExceptionDiekillThread'threadId=E.throwTothreadIdDie-- | 'timeOut'' is a variant which can be used for pure-- computations. The definition,---- @-- 'timeOut'' n = 'timeOut' n . 'E.evaluate'-- @---- ensures that @'timeOut'' 1 'B.bottom'@ usually returns @'Exception'-- \<something\>@. (@'timeOut' 1 ('return' 'B.bottom')@ usually-- returns @'Value' 'B.bottom'@; in other words, the computation-- reaches whnf almost immediately, defeating the purpose of the-- time-out.)timeOut'::Int->a->IO(Resulta)timeOut'n=timeOutn.E.evaluate-- | 'timeOutMicro'' is the equivalent variant of 'timeOutMicro':---- @-- 'timeOutMicro'' n = 'timeOutMicro' n . 'E.evaluate'-- @timeOutMicro'::Int->a->IO(Resulta)timeOutMicro'n=timeOutMicron.E.evaluate-------------------------------------------------------------------------- There shouldn't be any memory leaks in the code above. Profiling-- the code below also seems to suggest that there aren't any-- problems. However, GHCi (with :set +r) eats up more and more memory-- if the computation below is rerun a couple of times. Hmm, that-- seems to be the case also when running simply (reverse [1..]). It-- probably means that GHCi never releases any memory.main=doletn=1;d=000000{-# SCC "a" #-}timeOut'n(reverse[1..])>>=printthreadDelayd{-# SCC "b" #-}timeOut'n(reverse[1..])>>=printthreadDelayd{-# SCC "c" #-}timeOut'n(reverse[1..])>>=printthreadDelayd{-# SCC "d" #-}timeOut'n(reverse[1..])>>=print