diff --git a/haskell-prototype/BFS.hs b/haskell-prototype/BFS.hs index a1bca77b..421eb4e4 100644 --- a/haskell-prototype/BFS.hs +++ b/haskell-prototype/BFS.hs @@ -134,7 +134,8 @@ verbose :: Bool verbose = checkEnv "VERBOSE" False dbg :: Bool -dbg = checkEnv "DEBUG" False +-- dbg = checkEnv "DEBUG" False +dbg = False -- Let it inline, DCE. main :: IO () main = do diff --git a/haskell-prototype/LVarTracePure.hs b/haskell-prototype/LVarTracePure.hs index 6a6c9cbe..be5dbb0f 100644 --- a/haskell-prototype/LVarTracePure.hs +++ b/haskell-prototype/LVarTracePure.hs @@ -295,11 +295,11 @@ sched queue t = loop t -- potentially more expensive than in the plain IVar case.) -- e <- readIORef ref let thisCB x = - trace ("... LVar blocked, thresh attempted "++show(hashStableName$ unsafePerformIO$ makeStableName x)) +-- trace ("... LVar blocked, thresh attempted "++show(hashStableName$ unsafePerformIO$ makeStableName x)) fmap cont $ thresh x r <- atomicModifyIORef ref $ \ st@(LVarContents a ls) -> case thresh a of - Just b -> trace ("... LVar get, thresh passed ") + Just b -> -- trace ("... LVar get, thresh passed ") (st, loop (cont b)) Nothing -> (LVarContents a (thisCB:ls), reschedule queue) r @@ -322,7 +322,7 @@ sched queue t = loop t (ls',woken) = loop ls [] [] loop [] f w = (f,w) loop (hd:tl) f w = - case hd new of + case hd new' of Just trc -> loop tl f (trc:w) Nothing -> loop tl (hd:f) w -- Callbacks invoked: