Not all recursive functions are infinite loops... In general it's impossible to detect an infinite loop: it's the "Halting Problem".
IMO, the only way to do that is with a watchdog. You launch the evaluation in a separate thread, watch it, and if it doesn't finish you kill it and return a default value.
But maybe it's also possible to forbid any recursive program by analysing the AST?
I've used a watchdog in Nomyx (inspired from Mueval):
--Sets a watchdog to kill the evaluation thread if it doesn't finishes.
-- The function starts both the evaluation thread and the watchdog thread, and blocks awaiting the result.
-- Option 1: the evaluation thread finishes before the watchdog. The MVar is filled with the result,
-- which unblocks the main thread. The watchdog then finishes latter, and fills the MVar with Nothing.
-- Option 2: the watchdog finishes before the evaluation thread. The eval thread is killed, and the
-- MVar is filled with Nothing, which unblocks the main thread. The watchdog finishes.
evalWithWatchdog' :: NFData a => IO a -> IO (Maybe a)
evalWithWatchdog' s = do
mvar <- newEmptyMVar
hSetBuffering stdout NoBuffering
--start evaluation thread
id <- forkOS $ do
s' <- s
let s'' = force s'
putMVar mvar (Just s'')
--start watchdog thread
forkIO $ watchDog 3 id mvar
takeMVar mvar
-- | Fork off a thread which will sleep and then kill off the specified thread.
watchDog :: Int -> ThreadId -> MVar (Maybe a) -> IO ()
watchDog tout tid mvar = do
threadDelay (tout * 1000000)
killThread tid
putMVar mvar Nothing