diff --git a/Debug/Hoed.hs b/Debug/Hoed.hs
new file mode 100644
--- /dev/null
+++ b/Debug/Hoed.hs
@@ -0,0 +1,237 @@
+{-|
+Module      : Debug.Hoed
+Description : Lighweight algorithmic debugging based on observing intermediate values and the cost centre stack.
+Copyright   : (c) 2000 Andy Gill, (c) 2010 University of Kansas, (c) 2013-2014 Maarten Faddegon
+License     : BSD3
+Maintainer  : hoed@maartenfaddegon.nl
+Stability   : experimental
+Portability : POSIX
+
+Hoed is a tracer and debugger for the programming language Haskell. You can
+trace a program by annotating functions in suspected modules and linking your
+program against standard profiling libraries. 
+
+After running the program a computation tree is constructed and displayed in a
+web browser. You can freely browse this tree to get a better understanding of
+your program. If your program misbehaves, you can judge the computation
+statements in the tree as 'right' or 'wrong' according to your intention. When
+enough statements are judged the debugger tells you the location of the fault
+in your code.
+
+<<http://www.cs.kent.ac.uk/people/rpg/mf357/hoedv2.0.0.png>>
+
+I work on this debugger in the context of my Ph.D. research.
+Read more about the theory behind Hoed at <http://maartenfaddegon.nl/#pub>.
+
+To use Hoed on your own program, annotate your program as described below.
+For best results profiling is enabled and optimization disabled.
+If you use cabal to build your project, this is be done with:
+
+> cabal configure --disable-optimization --enable-profiling
+
+I am keen to hear about your experience with Hoed:
+where did you find it useful and where would you like to see improvement?
+You can send me an e-mail at hoed@maartenfaddegon.nl, or use the
+github issue tracker <https://github.com/MaartenFaddegon/hoed/issues>.
+
+-}
+
+module Debug.Hoed
+  ( -- * Basic annotations
+    observe
+  , runO
+  , printO
+
+    -- * Experimental annotations
+  , observeTempl
+  , observedTypes
+  , observeCC
+  , observe'
+  , Identifier(..)
+  ,(*>>=),(>>==),(>>=*)
+  , logO
+
+   -- * The Observable class
+  , Observer(..)
+  , Observable(..)
+  , (<<)
+  , thunk
+  , nothunk
+  , send
+  , observeBase
+  , observeOpaque
+  , debugO
+  , CDS(..)
+  , Generic
+  ) where
+
+
+import Debug.Hoed.Observe
+import Debug.Hoed.Render
+import Debug.Hoed.DemoGUI
+
+import Prelude hiding (Right)
+import qualified Prelude
+import System.IO
+import Data.Maybe
+import Control.Monad
+import Data.Array as Array
+import Data.List
+import Data.Char
+import System.Environment
+
+import Language.Haskell.TH
+import GHC.Generics
+
+import Data.IORef
+import System.IO.Unsafe
+import Data.Graph.Libgraph
+import Graphics.UI.Threepenny
+
+import System.Directory(createDirectoryIfMissing)
+
+
+-- %************************************************************************
+-- %*									*
+-- \subsection{External start functions}
+-- %*									*
+-- %************************************************************************
+
+-- Run the observe ridden code.
+
+-- | run some code and return the CDS structure (for when you want to write your own debugger).
+debugO :: IO a -> IO [CDS]
+debugO program = 
+     do { initUniq
+	; startEventStream
+        ; let errorMsg e = "[Escaping Exception in Code : " ++ show e ++ "]"
+	; ourCatchAllIO (do { program ; return () }) 
+			(hPutStrLn stderr . errorMsg)
+        ; events <- endEventStream
+	; return (eventsToCDS events)
+	}
+
+-- | Short for @runO . print@.
+printO :: (Show a) => a -> IO ()
+printO expr = runO (print expr)
+
+-- | print a string, with debugging 
+putStrO :: String -> IO ()
+putStrO expr = runO (putStr expr)
+
+-- | The main entry point; run some IO code, and debug inside it.
+--   After the IO action is completed, an algorithmic debugging session is started at
+--   @http://localhost:10000/@ to which you can connect with your webbrowser.
+-- 
+-- For example:
+--
+-- @ 
+--   main = runO $ do print (triple 3)
+--                    print (triple 2)
+-- @
+-- 
+
+runO :: IO a -> IO ()
+runO program = {- SCC "runO" -} do
+  let slices = [] -- MF TODO: this whole slices business should probably just go?
+  compGraph <- runO' program
+  debugSession slices compGraph
+  return ()
+
+runO' :: IO a -> IO CompGraph
+runO' program = {- SCC "runO" -} do
+  args <- getArgs
+  setPushMode (parseArgs args)
+  hPutStrLn stderr "=== program output ===\n"
+  cdss <- debugO program
+  let cdss1 = rmEntrySet cdss
+  let cdss2 = simplifyCDSSet cdss1
+  let eqs   = ((sortBy byStack) . renderCompStmts) cdss2
+  hPutStrLn stderr "\n=== CDS's before rendering === \n"
+  hPutStrLn stderr (show cdss2)
+  hPutStrLn stderr "\n=== Debug session === \n"
+  hPutStrLn stderr (showWithStack eqs)
+  return (mkGraph eqs)
+
+logO :: FilePath -> IO a -> IO ()
+logO filePath program = {- SCC "logO" -} do
+  compGraph <- runO' program
+  writeFile filePath (showGraph compGraph)
+  return ()
+
+  where showGraph g        = showWith g showVertex showArc
+        showVertex Root    = ("root","")
+        showVertex v       = (showCompStmts v ++ "\nwith stack "
+                              ++ (show . equStack . head . equations $ v), "")
+        showArc _          = ""
+        showCompStmts      = showCompStmts' . equations
+        showCompStmts' [e] = show e
+        showCompStmts' es  = foldl (\acc e-> acc ++ show e ++ ", ") "{" (init es) 
+                             ++ show (last es) ++ "}"
+  
+
+hPutStrList :: (Show a) => Handle -> [a] -> IO()
+hPutStrList h []     = hPutStrLn h ""
+hPutStrList h (c:cs) = do {hPutStrLn h (show c); hPutStrList h cs}
+
+
+------------------------------------------------------------------------
+-- Push mode option handling
+
+data PushMode = Vanilla | Drop | Truncate
+
+pushMode :: IORef PushMode
+pushMode = unsafePerformIO $ newIORef Vanilla
+
+setPushMode :: PushMode -> IO ()
+setPushMode = writeIORef pushMode
+
+getPushMode :: PushMode
+getPushMode = unsafePerformIO $ readIORef pushMode
+
+-- MF TODO: handle a bit nicer?
+parseArgs :: [String] -> PushMode
+parseArgs []      = Truncate -- default mode
+parseArgs (arg:_) = case arg of
+        "--PushVanilla"  -> Vanilla
+        "--PushDrop"     -> Drop
+        "--PushTruncate" -> Truncate
+        _              -> error ("unknown option " ++ arg)
+
+
+------------------------------------------------------------------------
+-- Algorithmic Debugging
+
+debugSession :: [(String,String)] -> CompGraph -> IO ()
+debugSession slices tree
+  = do createDirectoryIfMissing True ".Hoed/wwwroot/css"
+       writeFile ".Hoed/wwwroot/debug.css" stylesheet
+       treeRef <- newIORef tree
+       startGUI defaultConfig
+           { tpPort       = Just 10000
+           , tpStatic     = Just "./.Hoed/wwwroot"
+           } (demoGUI slices treeRef)
+
+
+stylesheet
+  =  "div {\n"
+  ++ "  padding:0;\n"
+  ++ "  margin:0;\n"
+  ++ "}\n"
+  ++ ".buttons {\n"
+  ++ "  float:top;\n"
+  ++ "  height:50vh;\n"
+  ++ "  overflow-y: scroll;\n"
+  ++ "  overflow-x: hidden;\n"
+  ++ "}\n"
+  ++ ".nowrap {\n"
+  ++ "  white-space: nowrap;\n"
+  ++ "}\n"
+  ++ ".odd {\n"
+  ++ "  background-color: lightgray;\n"
+  ++ "  padding: 10px 0;\n"
+  ++ "}\n"
+  ++ ".even {\n"
+  ++ "  background-color: white;\n"
+  ++ "  padding: 10px 0;\n"
+  ++ "}\n"
diff --git a/Debug/Hoed/DemoGUI.hs b/Debug/Hoed/DemoGUI.hs
new file mode 100644
--- /dev/null
+++ b/Debug/Hoed/DemoGUI.hs
@@ -0,0 +1,286 @@
+-- This file is part of the Haskell debugger Hoed.
+--
+-- Copyright (c) Maarten Faddegon, 2014
+
+module Debug.Hoed.DemoGUI
+where
+
+import Prelude hiding(Right)
+import Debug.Hoed.Render
+import Data.Graph.Libgraph
+import qualified Graphics.UI.Threepenny as UI
+import Graphics.UI.Threepenny (startGUI,defaultConfig,tpPort,tpStatic
+                              , Window, UI, (#), (#+), (#.), string, on
+                              )
+import System.Process(system)
+import Data.IORef
+import Data.List(intersperse,nub)
+import Text.Regex.Posix
+
+--------------------------------------------------------------------------------
+
+preorder :: CompGraph -> [Vertex]
+preorder = getPreorder . getDfs
+
+showStmt :: UI.Element -> IORef [Vertex] -> IORef Int -> UI ()
+showStmt e filteredVerticesRef currentVertexRef = do 
+  mv <- UI.liftIO $ lookupCurrentVertex currentVertexRef filteredVerticesRef
+  let s = case mv of
+                Nothing  -> "Select vertex above to show details."
+                (Just v) -> showCompStmts v
+  UI.element e # UI.set UI.text s
+  return ()
+
+data Filter = ShowAll | ShowSucc | ShowPred | ShowMatch
+
+demoGUI :: [(String,String)] -> IORef CompGraph -> Window -> UI ()
+demoGUI sliceDict treeRef window
+  = do return window # UI.set UI.title "Hoed debugging session"
+       UI.addStyleSheet window "debug.css"
+
+       -- Get a list of vertices from the computation graph
+       tree <- UI.liftIO $ readIORef treeRef
+       let ns = filter (not . isRoot) (preorder tree)
+
+       -- Shared memory
+       filteredVerticesRef <- UI.liftIO $ newIORef ns
+       currentVertexRef    <- UI.liftIO $ newIORef (0 :: Int)
+       regexRef            <- UI.liftIO $ newIORef ""
+
+       -- Draw the computation graph
+       img  <- UI.img 
+       redraw img treeRef (Just $ head ns)
+       img' <- UI.center #+ [UI.element img]
+
+       -- Field to show computation statement(s) of current vertex
+       compStmt <- UI.pre
+
+       -- Menu to select which statement to show
+       menu <- UI.select
+       showStmt compStmt filteredVerticesRef currentVertexRef
+       updateMenu menu treeRef currentVertexRef filteredVerticesRef
+       let selectVertex' = selectVertex compStmt filteredVerticesRef currentVertexRef                                           $ redrawWith img treeRef
+       on UI.selectionChange menu selectVertex'
+
+       -- Buttons for the various filters
+       filterTxt    <- UI.span   # UI.set UI.text "Filters: "
+       showAllBut   <- UI.button # UI.set UI.text "Show all"
+       showSuccBut  <- UI.button # UI.set UI.text "Show successors"
+       showPredBut  <- UI.button # UI.set UI.text "Show predecessors"
+       showMatchBut <- UI.button # UI.set UI.text "Matches "
+       matchField   <- UI.input
+       filters      <- UI.div #+ (map return [ filterTxt, showAllBut, showSuccBut, showPredBut
+                                             , showMatchBut, matchField])
+
+       on UI.valueChange matchField $ \s -> UI.liftIO $ writeIORef regexRef s
+       let onClickFilter' = onClickFilter menu treeRef currentVertexRef filteredVerticesRef
+                                          selectVertex' regexRef
+       onClickFilter' showAllBut   ShowAll
+       onClickFilter' showSuccBut  ShowSucc
+       onClickFilter' showPredBut  ShowPred
+       onClickFilter' showMatchBut ShowMatch
+
+       -- Status
+       status <- UI.span
+       updateStatus status treeRef 
+
+       -- Buttons to judge the current statement
+       right <- UI.button # UI.set UI.text "right"
+       wrong <- UI.button # UI.set UI.text "wrong"
+       let onJudge = onClick status menu img treeRef 
+                             currentVertexRef filteredVerticesRef
+       onJudge right Right
+       onJudge wrong Wrong
+
+       -- Populate the main screen
+       hr <- UI.hr
+       UI.getBody window #+ (map UI.element [filters, menu, right, wrong, status
+                                            , compStmt, hr,img'])
+       return ()
+
+updateMenu :: UI.Element -> IORef CompGraph
+              -> IORef Int -> IORef [Vertex] -> UI ()
+updateMenu menu treeRef currentVertexRef filteredVerticesRef = do
+       g  <- UI.liftIO $ readIORef treeRef
+       i  <- UI.liftIO $ readIORef currentVertexRef
+       ns <- UI.liftIO $ readIORef filteredVerticesRef
+       let fs = faultyVertices g
+       ops  <- mapM (\s->UI.option # UI.set UI.text s)
+                                $ if ns == [] then ["No matches found"]
+                                  else map (summarizeVertex fs) ns
+       (UI.element menu) # UI.set UI.children []
+       UI.element menu #+ (map UI.element ops)
+       (UI.element menu) # UI.set UI.selection (Just i)
+       return ()
+
+vertexFilter :: Filter -> CompGraph -> Vertex -> String -> [Vertex]
+vertexFilter f g cv r = filter (not . isRoot) $ case f of 
+  ShowAll   -> preorder g
+  ShowSucc  -> succs g cv
+  ShowPred  -> preds g cv
+  ShowMatch -> filter matches (preorder g)
+    where matches Root = False
+          matches v    = showCompStmts v =~ r
+
+onClick :: UI.Element -> UI.Element -> UI.Element 
+           -> IORef CompGraph -> IORef Int -> IORef [Vertex]
+           -> UI.Element -> Judgement-> UI ()
+onClick status menu img treeRef currentVertexRef filteredVerticesRef b j = do
+  on UI.click b $ \_ -> do
+        (Just v) <- UI.liftIO $ lookupCurrentVertex currentVertexRef filteredVerticesRef
+        replaceFilteredVertex v (v{status=j})
+        updateTree img treeRef (Just v) (\tree -> markNode tree v j)
+        updateMenu menu treeRef currentVertexRef filteredVerticesRef
+        updateStatus status treeRef
+
+  where replaceFilteredVertex v w = do
+          vs <- UI.liftIO $ readIORef filteredVerticesRef
+          UI.liftIO $ writeIORef filteredVerticesRef $ map (\x -> if x == v then w else x) vs
+
+lookupCurrentVertex :: IORef Int -> IORef [Vertex] -> IO (Maybe Vertex)
+lookupCurrentVertex currentVertexRef filteredVerticesRef = do
+  i <- readIORef currentVertexRef
+  m <- readIORef filteredVerticesRef
+  return $ if i < length m then Just (m !! i) else Nothing
+
+-- onSelectVertex :: UI.Element -> UI.Element -> IORef [Vertex] -> IORef Int 
+--                   -> (IORef [Vertex] -> IORef Int -> UI ()) -> UI ()
+-- onSelectVertex menu compStmt filteredVerticesRef currentVertexRef myRedraw = do
+--   on UI.selectionChange menu $ \mi -> case mi of
+--         Just i  -> do UI.liftIO $ writeIORef currentVertexRef i
+--                       showStmt compStmt filteredVerticesRef currentVertexRef
+--                       myRedraw filteredVerticesRef currentVertexRef 
+--                       return ()
+--         Nothing -> return ()
+
+selectVertex :: UI.Element -> IORef [Vertex] -> IORef Int  
+        -> (IORef [Vertex] -> IORef Int -> UI ()) -> Maybe Int -> UI ()
+selectVertex compStmt filteredVerticesRef currentVertexRef myRedraw mi = case mi of
+        Just i  -> do UI.liftIO $ writeIORef currentVertexRef i
+                      showStmt compStmt filteredVerticesRef currentVertexRef
+                      myRedraw filteredVerticesRef currentVertexRef 
+                      return ()
+        Nothing -> return ()
+
+
+onClickFilter :: UI.Element -> IORef CompGraph -> IORef Int -> IORef [Vertex] 
+                  -> (Maybe Int -> UI ()) -> IORef String -> UI.Element -> Filter -> UI ()
+onClickFilter menu treeRef currentVertexRef filteredVerticesRef selectVertex' regexRef e fil = do
+  on UI.click e $ \_ -> do
+    mcv <- UI.liftIO $ lookupCurrentVertex currentVertexRef filteredVerticesRef
+    g <- UI.liftIO $ readIORef treeRef
+    r <- UI.liftIO $ readIORef regexRef
+    let cv = case mcv of (Just v) -> v
+                         Nothing  -> head . (filter $ not . isRoot) . preorder $ g
+        applyFilter f = do UI.liftIO $ writeIORef filteredVerticesRef (vertexFilter f g cv r)
+                           UI.liftIO $ writeIORef currentVertexRef 0
+    applyFilter fil
+    updateMenu menu treeRef currentVertexRef filteredVerticesRef
+    selectVertex' (Just 0)
+
+-- MF TODO: We may need to reconsider how Vertex is defined,
+-- and how we determine equality. I think it could happen that
+-- two vertices with equal equation but different stacks/relations
+-- are now both changed.
+markNode :: CompGraph -> Vertex -> Judgement -> CompGraph
+markNode g v s = mapGraph f g
+  where f Root = Root
+        f v'   = if v' === v then v{status=s} else v'
+
+        (===) :: Vertex -> Vertex -> Bool
+        v1 === v2 = (equations v1) == (equations v2)
+
+data MaxStringLength = ShorterThan Int | Unlimited
+
+shorten :: MaxStringLength -> String -> String
+shorten Unlimited s = s
+shorten (ShorterThan l) s
+          | length s < l = s
+          | l > 3        = take (l - 3) s ++ "..."
+          | otherwise    = take l s
+
+-- MF TODO: Maybe we should do something smart with witespace substitution here?
+noNewlines :: String -> String
+noNewlines = filter (/= '\n')
+
+showCompStmts :: Vertex -> String
+showCompStmts = commas . map show . equations
+
+summarizeVertex :: [Vertex] -> Vertex -> String
+summarizeVertex fs v = shorten (ShorterThan 27) (noNewlines $ showCompStmts v) ++ s
+  where s = if v `elem` fs then " !!" else case status v of
+              Unassessed     -> " ??"
+              Wrong          -> " :("
+              Right          -> " :)"
+
+updateStatus :: UI.Element -> IORef CompGraph -> UI ()
+updateStatus e compGraphRef = do
+  g <- UI.liftIO $ readIORef compGraphRef
+  let getLabel   = commas . (map equLabel) . equations
+      isJudged v = status v /= Unassessed
+      slen       = show . length
+      ns = filter (not . isRoot) (preorder g)
+      js = filter isJudged ns
+      fs = faultyVertices g
+      txt = if length fs > 0 then " Fault detected in: " ++ getLabel (head fs)
+                             else " Judged " ++ slen js ++ "/" ++ slen ns
+  UI.element e # UI.set UI.text txt
+  return ()
+
+updateTree :: UI.Element -> IORef CompGraph -> (Maybe Vertex) -> (CompGraph -> CompGraph)
+           -> UI ()
+updateTree img treeRef mcv f
+  = do tree <- UI.liftIO $ readIORef treeRef
+       UI.liftIO $ writeIORef treeRef (f tree)
+       redraw img treeRef mcv
+
+redrawWith :: UI.Element -> IORef CompGraph -> IORef [Vertex] -> IORef Int -> UI ()
+redrawWith img treeRef filteredVerticesRef currentVertexRef = do
+  mv <- UI.liftIO $ lookupCurrentVertex currentVertexRef filteredVerticesRef
+  redraw img treeRef mv
+
+redraw :: UI.Element -> IORef CompGraph -> (Maybe Vertex) -> UI ()
+redraw img treeRef mcv
+  = do tree <- UI.liftIO $ readIORef treeRef
+       UI.liftIO $ writeFile ".Hoed/debugTree.dot" (shw $ summarize tree mcv)
+       UI.liftIO $ system $ "dot -Tpng -Gsize=9,5 -Gdpi=100 .Hoed/debugTree.dot "
+                          ++ "> .Hoed/wwwroot/debugTree.png"
+       url <- UI.loadFile "image/png" ".Hoed/wwwroot/debugTree.png"
+       UI.element img # UI.set UI.src url
+       return ()
+
+  where shw g = showWith g (coloVertex $ faultyVertices g) showArc
+        coloVertex fs v = ( summarizeVertex fs v 
+                          , if isCurrentVertex mcv v then "style=filled fillcolor=yellow"
+                                                     else ""
+                          )
+        showArc _  = ""
+
+-- MF TODO: summarize now just "throws away" some vertices if there are too
+-- many. Better would be to inject summarizing nodes (e.g. "and 25 more").
+summarize :: CompGraph -> Maybe Vertex -> CompGraph
+summarize g mcv = Graph (root g) keep as
+  where keep1 v = take 7 $ succs g v
+        keep'   = nub $ Root : foldl (\ks v -> ks ++ keep1 v) [] (vertices g)
+        keep    = case filter (isCurrentVertex mcv) (vertices g) of
+                        []    -> keep'
+                        (w:_) -> if w `elem` keep' then keep' else w : keep
+        as      = filter (\(Arc v w _) -> v `elem` keep && w `elem` keep) (arcs g)
+
+isCurrentVertex :: Maybe Vertex -> Vertex -> Bool
+isCurrentVertex mcv v = case v of
+  Root -> False
+  _    -> case mcv of 
+                Nothing     -> False
+                (Just Root) -> False
+                (Just w)    -> equations v == equations w
+
+commas :: [String] -> String
+commas [e] = e
+commas es  = foldl (\acc e-> acc ++ e ++ ", ") "{" (init es) 
+                     ++ show (last es) ++ "}"
+
+faultyVertices :: CompGraph -> [Vertex]
+faultyVertices = findFaulty_dag getStatus
+  where getStatus Root = Right
+        getStatus v    = status v
diff --git a/Debug/Hoed/Observe.lhs b/Debug/Hoed/Observe.lhs
--- a/Debug/Hoed/Observe.lhs
+++ b/Debug/Hoed/Observe.lhs
@@ -46,32 +46,38 @@
   (
    -- * The main Hood API
   
-     observe
-  , gdmobserve
+    observeTempl
+  , observe
+  , observe'
+  , observeCC
   , Observer(..)   -- contains a 'forall' typed observe (if supported).
   -- , Observing      -- a -> a
   , Observable(..) -- Class
-  , runO	   -- IO a -> IO ()
-  , printO	   -- a -> IO ()
-  , putStrO	   -- String -> IO ()
 
    -- * For advanced users, that want to render their own datatypes.
   , (<<)           -- (Observable a) => ObserverM (a -> b) -> a -> ObserverM b
+  ,(*>>=),(>>==),(>>=*)
   , thunk          -- (Observable a) => a -> ObserverM a	
   , nothunk
   , send
   , observeBase
   , observeOpaque
-
   , observedTypes
-
-  -- * For users that want to write there own render drivers.
-  
-  , debugO	   -- IO a -> IO [CDS]
-  , CDS(..)
-
   , Generic
-  ) where	
+  , CallStack
+  , emptyStack
+  , Event(..)
+  , Change(..)
+  , Parent(..)
+  , ThreadId(..)
+  , Identifier(..)
+  , initUniq
+  , startEventStream
+  , endEventStream
+  , ourCatchAllIO
+  , peepUniq
+  , ccsToStrings
+  ) where
 \end{code}
 
 
@@ -82,30 +88,43 @@
 %************************************************************************
 
 \begin{code}
+import Prelude hiding (Right)
+import qualified Prelude
 import System.IO
 import Data.Maybe
 import Control.Monad
 import Data.Array as Array
 import Data.List
 import Data.Char
---import System
+import System.Environment
 
 import Language.Haskell.TH
 import GHC.Generics
 
--- The only non standard one we assume
---import IOExts
 import Data.IORef
 import System.IO.Unsafe
+
+import Control.Concurrent(takeMVar,putMVar,MVar,newMVar)
+import qualified Control.Concurrent as Concurrent
 \end{code}
 
+Needed to access the cost centre stack:
 \begin{code}
-import Control.Concurrent
+import GHC.Stack (ccLabel, getCurrentCCS, CostCentreStack,ccsCC,ccsParent,currentCallStack)
+import GHC.Foreign as GHC
+import GHC.Ptr
 \end{code}
 
+For the TracedMonad instance of IO:
 \begin{code}
-import Control.Exception ( Exception, throw )
+import GHC.Base
+-- import Control.Monad.ST(RealWorld)
+-- import Control.Monad.State(State)
+\end{code}
+
+\begin{code}
 import qualified Control.Exception as Exception
+import Control.Exception (Exception, throw, ErrorCall(..), SomeException(..))
 {-
  ( catch
 		, Exception(..)
@@ -122,91 +141,6 @@
 
 %************************************************************************
 %*									*
-\subsection{External start functions}
-%*									*
-%************************************************************************
-
-Run the observe ridden code.
-
-\begin{code}
--- | run some code and return the CDS structure (for when you want to write your own debugger).
-debugO :: IO a -> IO [CDS]
-debugO program = 
-     do { initUniq
-	; startEventStream
-        ; let errorMsg e = "[Escaping Exception in Code : " ++ show e ++ "]"
-	; ourCatchAllIO (do { program ; return () }) 
-			(hPutStrLn stderr . errorMsg)
-        ; events <- endEventStream
-	; return (eventsToCDS events)
-	}
-
--- | print a value, with debugging 
-printO :: (Show a) => a -> IO ()
-printO expr = runO (print expr)
-
--- | print a string, with debugging 
-putStrO :: String -> IO ()
-putStrO expr = runO (putStr expr)
-
--- | The main entry point; run some IO code, and debug inside it.
--- 
--- An example of using this debugger is 
---
--- @runO (print [ observe "+1" (+1) x | x <- observe "xs" [1..3]])@
--- 
--- @[2,3,4]
--- -- +1
---  { \ 1  -> 2
---  }
--- -- +1
---  { \ 2  -> 3
---  }
--- -- +1
---  { \ 3  -> 4
---  }
--- -- xs
---  1 : 2 : 3 : []@
--- 
--- Which says, the return is @[2,3,4]@, there were @3@ calls to +1
--- (showing arguments and results), and @xs@, which was the list
--- @1 : 2 : 3 : []@.
--- 
-
-runO :: IO a -> IO ()
-runO program =
-    do { cdss <- debugO program
-       ; let cdss1 = rmEntrySet cdss
-       ; let cdss2 = simplifyCDSSet cdss1
-       ; let output1 = cdssToOutput cdss2 
-       ; let output2 = commonOutput output1
-       ; let ptyout  = pretty 80 (foldr (<>) nil (map renderTop output2))
-       ; hPutStrLn stderr ""
-       ; hPutStrLn stderr ptyout
-       }
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Simulations}
-%*									*
-%************************************************************************
-
-Here we provide stubs for the functionally that is not supported
-by some compilers, and provide some combinators of various flavors.
-
-\begin{code}
-ourCatchAllIO :: IO a -> (Exception.SomeException -> IO a) -> IO a
-ourCatchAllIO = Exception.catch
-
-handleExc :: Parent -> Exception.SomeException -> IO a
-handleExc context exc = return (send "throw" (return throw << exc) context)
-\end{code}
-
-
-%************************************************************************
-%*									*
 \subsection{GDM Generics}
 %*									*
 %************************************************************************
@@ -242,6 +176,7 @@
 instance (GObservable a) => GObservable (M1 D d a) where
         gdmobserver m@(M1 x) cxt = M1 (gdmobserver x cxt)
         gdmObserveChildren = gthunk
+        gdmShallowShow = undefined
 
 -- Meta: Constructors
 instance (GObservable a, Constructor c) => GObservable (M1 C c a) where
@@ -257,12 +192,13 @@
           | selName m == "" = M1 (gdmobserver x cxt)
           | otherwise       = M1 (send (selName m ++ " =") (gdmObserveChildren x) cxt)
         gdmObserveChildren = gthunk
+        gdmShallowShow = undefined
 
 -- Unit: used for constructors without arguments
 instance GObservable U1 where
         gdmobserver x _ = x
-
         gdmObserveChildren = return
+        gdmShallowShow = undefined
 
 -- Products: encode multiple arguments to constructors
 instance (GObservable a, GObservable b) => GObservable (a :*: b) where
@@ -272,6 +208,7 @@
                                           b'  <- gdmObserveChildren b
                                           return (a' :*: b')
                                        
+        gdmShallowShow = undefined
 
 -- Sums: encode choice between constructors
 instance (GObservable a, GObservable b) => GObservable (a :+: b) where
@@ -281,11 +218,15 @@
         gdmObserveChildren (R1 x) = do {x' <- gdmObserveChildren x; return (R1 x')}
         gdmObserveChildren (L1 x) = do {x' <- gdmObserveChildren x; return (L1 x')}
 
+        gdmShallowShow = undefined
+
 -- Constants: additional parameters and recursion of kind *
 instance (Observable a) => GObservable (K1 i a) where
         gdmobserver (K1 x) cxt = K1 (observer_ observer x cxt)
 
         gdmObserveChildren = gthunk
+
+        gdmShallowShow = undefined
 \end{code}
 
 Observing functions is done via the ad-hoc mechanism, because
@@ -302,15 +243,59 @@
 \begin{code}
 gdmFunObserver :: (Observable a,Observable b) => Parent -> (a->b) -> (a->b)
 gdmFunObserver cxt fn arg
-        = sendObserveFnPacket (do { arg' <- thunk observer arg
-                                  ; thunk observer (fn arg')
-                                  }
-                              ) cxt
+        = let (app,stack) = getStack 
+                          $ sendObserveFnPacket stack
+                            (do arg' <- thunk observer arg
+                                thunk observer (fn arg')
+                            ) cxt
+          in app
 \end{code}
 
 
+
+
 %************************************************************************
 %*									*
+\subsection{Cost Centre Stack}
+%*									*
+%************************************************************************
+
+\begin{code}
+
+type CallStack = [String]
+emptyStack = [""]
+
+{-# NOINLINE getStack #-}
+getStack :: a -> (a, CallStack)
+getStack x = let stack = unsafePerformIO
+                         $ do {ccs <- getCurrentCCS (); ccsToStrings ccs}
+             in  (x, rev stack)
+        where rev []    = []
+              -- rev s    = reverse (tail s)
+              rev (h:s) = let s' = case h of "CAF" -> s
+                                             _     -> h:s 
+                          in reverse s'
+
+
+ccsToStrings :: Ptr CostCentreStack -> IO [String]
+ccsToStrings ccs0 = go ccs0 []
+  where
+    go ccs acc
+     | ccs == nullPtr = return acc
+     | otherwise = do
+        cc  <- ccsCC ccs
+        lbl <- GHC.peekCString utf8 =<< ccLabel cc
+        parent <- ccsParent ccs
+        if (lbl == "MAIN")
+           then return acc
+           else go parent (lbl : acc)
+
+
+\end{code}
+
+
+%************************************************************************
+%*									*
 \subsection{Generics}
 %*									*
 %************************************************************************
@@ -319,11 +304,11 @@
 Where gobserve is the 'classic' observe but parametrized.
 
 \begin{code}
-observe :: String -> Q Exp
-observe s = do n  <- methodName s
-               let f  = return $ VarE n
-                   s' = stringE s
-               [| (\x-> gobserve $f $s' x) |]
+observeTempl :: String -> Q Exp
+observeTempl s = do n  <- methodName s
+                    let f  = return $ VarE n
+                        s' = stringE s
+                    [| (\x-> fst (gobserve $f DoNotTraceThreadId UnknownId $s' x)) |]
 \end{code}
 
 Generate class definition and class instances for list of types.
@@ -334,8 +319,8 @@
                         ci <- foldM f [] qt
                         bi <- foldM g [] baseTypes
                         fi <- (gfunObserver s)
-                        li <- (gListObserver s)
-                        return (cd ++ ci ++ bi ++ fi ++ li)
+                        -- li <- (gListObserver s) MF TODO: should we do away with these?
+                        return (cd ++ ci ++ bi ++ fi)
         where f d t = do ds <- (gobservableInstance s t)
                          return (ds ++ d)
               g d t = do ds <- (gobservableBaseInstance s t)
@@ -416,6 +401,8 @@
            ( normalB [| send $(shallowShow y) $(observeChildren n t bs y evars) $c |]
            ) []
        }
+gobserverClause t n bs (InfixC left name right) 
+  = gobserverClause t n bs (NormalC name (left:[right]))
 gobserverClause t n bs y = error ("gobserverClause can't handle " ++ show y)
 
 listClauses :: Q Name -> Q [Clause]
@@ -481,7 +468,7 @@
 updateContext cn ps = map f ps
         where f (ClassP n ts)
                 | nameBase n == "Observable" = ClassP cn ts
-                | otherwise                  = ClassP  n ts
+                | otherwise                  = ClassP n  ts
               f p = p
 
 gobservableBaseInstance :: String -> Q Type -> Q [Dec]
@@ -513,17 +500,17 @@
                 _                  -> return []
        return [InstanceD c n m]
 
-gListObserver :: String -> Q [Dec]
-gListObserver s
-  = do cn <- className s
-       let ct = conT cn
-           a  = VarT (mkName "a")
-           a' = return a
-       p <- classP cn [a']
-       c <- return [p]
-       n <- [t| $ct [$a'] |]
-       m <- gobserverList (methodName s)
-       return [InstanceD c n m]
+-- MF TODO: what do we do with this?
+-- gListObserver :: String -> Q [Dec]
+-- gListObserver s
+--   = do cn <- className s
+--        let ct = conT cn
+--            a  = VarT (mkName "a")
+--            a' = return a
+--        c <- return [ClassP cn a']
+--        n <- [t| $ct [$a'] |]
+--        m <- gobserverList (methodName s)
+--        return [InstanceD c n m]
 
 
 gobserverFunClause :: Name -> Q Clause
@@ -533,9 +520,12 @@
              [f, c, a] = map varE vs
              pvars     = map varP vs
        ; clause pvars 
-         (normalB [| sendObserveFnPacket ( do a' <- thunk $(varE n) $a
-                                              thunk $(varE n) ($f a')
-                                         ) $c
+         (normalB [| let (app,stack) = getStack 
+                                     $ sendObserveFnPacket stack
+                                       ( do a' <- thunk $(varE n) $a
+                                            thunk $(varE n) ($f a')
+                                       ) $c
+                     in app
                   |]
          ) []
        }
@@ -556,9 +546,9 @@
            f  = return $ AppT (AppT ArrowT a) b
            a' = return a
            b' = return b
-       pa <- classP cn [a']
-       pb <- classP cn [b']
-       c <- return [pa,pb]
+       p <- return $ ClassP cn a'
+       q <- return $ ClassP cn b'
+       c <- return [p,q]
        n <- [t| $ct $f |]
        m <- gobserverFun (methodName s)
        return [InstanceD c n m]
@@ -569,7 +559,8 @@
 
 \begin{code}
 shallowShow :: Con -> ExpQ
-shallowShow (NormalC name _) = stringE (nameBase name)
+shallowShow (NormalC name _)
+  = stringE (case (nameBase name) of "(,)" -> ","; s -> s)
 \end{code}
 
 Observing the children of Data types of kind *.
@@ -584,18 +575,23 @@
 \begin{code}
 
 isObservable :: TyVarMap -> Type -> Type -> Q Bool
-isObservable bs s t = if s == t then return True else isObservable' bs t
+-- MF TODO: if s == t then return True else isObservable' bs t
+isObservable bs s t = isObservable' bs t
+
+-- MF TODO this is a hack
+isObservable' bs (AppT ListT _)    = return True
+
 isObservable' bs (VarT n)      = case lookupBinding bs n of
                                       (Just (T t)) -> isObservableT t
                                       (Just (P p)) -> isObservableP p
                                       Nothing      -> return False
-isObservable' bs (AppT t _)    = isObservable' bs t
+-- isObservable' bs (AppT t _)    = isObservable' bs t
 isObservable' (n,_) t@(ConT m) = if n == m then return True else isObservableT t
 isObservable' bs t             = isObservableT t
 
 isObservableT :: Type -> Q Bool
-isObservableT t@(ConT _)                 = isInstance (mkName "Observable") [t]
-isObservableT _                          = return False 
+isObservableT t@(ConT _) = isInstance (mkName "Observable") [t]
+isObservableT _          = return False 
 
 isObservableP :: Pred -> Q Bool
 isObservableP (ClassP n _) = return $ (nameBase n) == "Observable"
@@ -626,20 +622,6 @@
                         }
 \end{code}
 
-Observing functions is done via the ad-hoc mechanism, because
-we provide an instance definition the default is ignored for
-this type.
-
-\begin{code}
-funObserver :: (Observable a,Observable b) => (a->b) -> Parent -> (a->b)
-funObserver f c a = sendObserveFnPacket ( do a' <- thunk observer a
-                                             thunk observer (f a')
-                                        ) c
-
--- instance (Observable a,Observable b) => Observable (a -> b) where
---   observer = funObserver
-\end{code}
-
 And we need some helper functions:
 
 \begin{code}
@@ -680,14 +662,20 @@
 getPBindings' :: [Pred] -> Q [Pred]
 getPBindings' []     = return []
 getPBindings' (p:ps) = do pbs <- getPBindings' ps
-                          return $ case p of (ClassP n t) -> p : pbs
+                          return $ case p of (ClassP n t)   -> p : pbs
                                              _            -> pbs
 
 -- Given a parametrized type, get a list with its type variables
 -- e.g. [a,b] in (MyData a b) Int Float
 
 getTvbs :: Q Name -> Q [TyVarBndr]
-getTvbs name = do {n <- name; TyConI (DataD _ _ tvbs _ _)  <- reify n; return tvbs}
+getTvbs name = do n <- name
+                  i <- reify n
+                  case i of
+                    TyConI (DataD _ _ tvbs _ _) 
+                      -> return tvbs
+                    i
+                      -> error ("getTvbs: can't reify " ++ show i)
 
 -- Given a parametrized type, get a list with the bindings of type variables
 -- e.g. [Int,Float] in (MyData a b) Int Float
@@ -713,6 +701,9 @@
       		(ForallT _ _ t'') -> getName' t''
                 (AppT t'' _)      -> getName' t''
       		(ConT name)       -> return name
+                ListT             -> return $ mkName "[]"
+                TupleT _          -> return $ mkName "(,)"
+                t''               -> error ("getName can't handle " ++ show t'')
 
 -- Given a type, get a list of type variables.
 
@@ -805,7 +796,7 @@
 
 instance (Observable a,Observable b) => Observable (Either a b) where
   observer (Left a)  = send "Left"  (return Left  << a)
-  observer (Right a) = send "Right" (return Right << a)
+  observer (Prelude.Right a) = send "Right" (return Prelude.Right << a)
 \end{code}
 
 Arrays.
@@ -829,14 +820,15 @@
 
 
 The Exception *datatype* (not exceptions themselves!).
-For now, we only display IOExceptions and calls to Error.
 
 \begin{code}
-instance Observable Exception.SomeException where
---  observer (IOException a)      = observeOpaque "IOException" (IOException a)
---  observer (ErrorCall a)        = send "ErrorCall"   (return ErrorCall << a)
-  observer other                = send "<Exception>" (return other)
+instance Observable SomeException where
+  observer e = send ("<Exception> " ++ show e) (return e)
 
+-- instance Observable ErrorCall where
+--   observer (ErrorCall a)        = send "ErrorCall"   (return ErrorCall << a)
+
+
 instance Observable Dynamic where { observer = observeOpaque "<Dynamic>" }
 \end{code}
 
@@ -847,62 +839,52 @@
 %*									*
 %************************************************************************
 
-MF TODO: remove
-
-class Observable a where
-	{-
-	 - This reveals the name of a specific constructor.
-	 - and gets ready to explain the sub-components.
-         -
-         - We put the context second so we can do eta-reduction
-	 - with some of our definitions.
-	 -}
-	observer  :: a -> Parent -> a 
-
+\begin{code}
 type Observing a = a -> a
+\end{code}
 
-MF TODO: end
+MF: when do we need this type?
 
 \begin{code}
 newtype Observer = O (forall a . (Observable a) => String -> a -> a)
 
-defaultObservers :: (Observable a) => String -> (Observer -> a) -> a
-defaultObservers label fn = unsafeWithUniq $ \ node ->
-     do { sendEvent node (Parent 0 0) (Observe label)
-	; let observe' sublabel a
-	       = unsafeWithUniq $ \ subnode ->
-		 do { sendEvent subnode (Parent node 0) 
-		                        (Observe sublabel)
-		    ; return (observer_ observer a (Parent
-			{ observeParent = subnode
-			, observePort   = 0
-		        }))
-		    }
-        ; return (observer_ observer (fn (O observe'))
-		       (Parent
-			{ observeParent = node
-			, observePort   = 0
-		        }))
-	}
-defaultFnObservers :: (Observable a, Observable b) 
-		      => String -> (Observer -> a -> b) -> a -> b
-defaultFnObservers label fn arg = unsafeWithUniq $ \ node ->
-     do { sendEvent node (Parent 0 0) (Observe label)
-	; let observe' sublabel a
-	       = unsafeWithUniq $ \ subnode ->
-		 do { sendEvent subnode (Parent node 0) 
-		                        (Observe sublabel)
-		    ; return (observer_ observer a (Parent
-			{ observeParent = subnode
-			, observePort   = 0
-		        }))
-		    }
-        ; return (observer_ observer (fn (O observe'))
-		       (Parent
-			{ observeParent = node
-			, observePort   = 0
-		        }) arg)
-	}
+-- defaultObservers :: (Observable a) => String -> (Observer -> a) -> a
+-- defaultObservers label fn = unsafeWithUniq $ \ node ->
+--      do { sendEvent node (Parent 0 0) (Observe label ThreadIdUnknown)
+-- 	; let observe' sublabel a
+-- 	       = unsafeWithUniq $ \ subnode ->
+-- 		 do { sendEvent subnode (Parent node 0) 
+-- 		                        (Observe sublabel ThreadIdUnknown)
+-- 		    ; return (observer_ observer a (Parent
+-- 			{ observeParent = subnode
+-- 			, observePort   = 0
+-- 		        }))
+-- 		    }
+--         ; return (observer_ observer (fn (O observe'))
+-- 		       (Parent
+-- 			{ observeParent = node
+-- 			, observePort   = 0
+-- 		        }))
+-- 	}
+-- defaultFnObservers :: (Observable a, Observable b) 
+-- 		      => String -> (Observer -> a -> b) -> a -> b
+-- defaultFnObservers label fn arg = unsafeWithUniq $ \ node ->
+--      do { sendEvent node (Parent 0 0) (Observe label ThreadIdUnknown)
+-- 	; let observe' sublabel a
+-- 	       = unsafeWithUniq $ \ subnode ->
+-- 		 do { sendEvent subnode (Parent node 0) 
+-- 		                        (Observe sublabel ThreadIdUnknown)
+-- 		    ; return (observer_ observer a (Parent
+-- 			{ observeParent = subnode
+-- 			, observePort   = 0
+-- 		        }))
+-- 		    }
+--         ; return (observer_ observer (fn (O observe'))
+-- 		       (Parent
+-- 			{ observeParent = node
+-- 			, observePort   = 0
+-- 		        }) arg)
+-- 	}
 \end{code}
 
 
@@ -986,13 +968,54 @@
 -- 'observe' can also observe functions as well a structural values.
 -- 
 {-# NOINLINE gobserve #-}
-gobserve :: (a->Parent->a) -> String -> a -> a
-gobserve f name a = generateContext f name a 
+gobserve :: (a->Parent->a) -> TraceThreadId -> Identifier -> String -> a -> (a,Int)
+gobserve f tti d name a = generateContext f tti d name a
 
-{-# NOINLINE gdmobserve #-}
-gdmobserve ::  (Observable a) => String -> a -> a
-gdmobserve = gobserve observer
+{- | 
+Functions which you suspect of misbehaving are annotated with observe and
+should have a cost centre set. The name of the function, the label of the cost
+centre and the label given to observe need to be the same.
 
+Consider the following function:
+
+@triple x = x + x@
+
+This function is annotated as follows:
+
+> triple y = (observe "triple" (\x -> {# SCC "triple" #}  x + x)) y
+
+To produce computation statements like:
+
+@triple 3 = 6@
+
+To observe a value its type needs to be of class Observable.
+We provided instances for many types already.
+If you have defined your own type, and want to observe a function
+that takes a value of this type as argument or returns a value of this type,
+an Observable instance can be derived as follows:
+
+@  
+  data MyType = MyNumber Int | MyName String deriving Generic
+
+  instance Observable MyType
+@
+-}
+{-# NOINLINE observe #-}
+observe ::  (Observable a) => String -> a -> a
+observe lbl = fst . (gobserve observer DoNotTraceThreadId UnknownId lbl)
+
+{-# NOINLINE observeCC #-}
+observeCC ::  (Observable a) => String -> a -> a
+observeCC lbl = fst . (gobserve observer TraceThreadId UnknownId lbl)
+
+data Identifier = UnknownId | DependsJustOn Int | InSequenceAfter Int
+     deriving (Show, Eq, Ord)
+
+{-# NOINLINE observe' #-}
+observe' :: (Observable a) => String -> Identifier -> a -> (a,Int)
+observe' lbl d x = let (y,i) = (gobserve observer DoNotTraceThreadId d lbl) x
+                      in  (y, i)
+
 {- This gets called before observer, allowing us to mark
  - we are entering a, before we do case analysis on
  - our object.
@@ -1015,12 +1038,8 @@
 data Parent = Parent
 	{ observeParent :: !Int	-- my parent
 	, observePort   :: !Int	-- my branch number
-	} deriving Show
+	} deriving (Show, Read)
 root = Parent 0 0
-
-
-add :: Parent -> Int -> Parent
-add (Parent parent port) i = Parent parent (port+1)
 \end{code}
 
 
@@ -1035,22 +1054,22 @@
 \end{code}
 
 \begin{code}
-generateContext :: (a->Parent->a) -> String -> a -> a
-generateContext f label orig = unsafeWithUniq $ \ node ->
-     do { sendEvent node (Parent 0 0) (Observe label)
+data TraceThreadId = TraceThreadId | DoNotTraceThreadId
+
+generateContext :: (a->Parent->a) -> TraceThreadId -> Identifier -> String -> a -> (a,Int)
+generateContext f tti d label orig = unsafeWithUniq $ \ node ->
+     do { t <- myThreadId
+        ; sendEvent node (Parent 0 0) (Observe label t node d)
 	; return (observer_ f orig (Parent
 			{ observeParent = node
 			, observePort   = 0
 		        })
-		  )
-	}
-
-send' :: String -> Int -> ObserverM a -> Parent -> (Int,a)
-send' consLabel fixity fn context = unsafeWithUniq $ \ node ->
-     do { let (r,portCount) = runMO fn node 0
-	; sendEvent node context (Cons fixity consLabel)
-	; return (node,r)
+		 , node)
 	}
+  where myThreadId = case tti of
+          DoNotTraceThreadId -> return ThreadIdUnknown
+          TraceThreadId      -> do t <- Concurrent.myThreadId
+                                   return (ThreadId t)
 
 send :: String -> ObserverM a -> Parent -> a
 send consLabel fn context = unsafeWithUniq $ \ node ->
@@ -1085,10 +1104,11 @@
 evaluate a = a `seq` return a
 
 
-sendObserveFnPacket :: ObserverM a -> Parent -> a
-sendObserveFnPacket fn context = unsafeWithUniq $ \ node ->
+sendObserveFnPacket :: CallStack -> ObserverM a -> Parent -> a
+sendObserveFnPacket callStack fn context
+  = unsafeWithUniq $ \ node ->
      do	{ let (r,_) = runMO fn node 0
-	; sendEvent node context Fun
+	; sendEvent node context (Fun callStack)
 	; return r
 	}
 \end{code}
@@ -1108,15 +1128,19 @@
 		, parent     :: !Parent
 		, change     :: !Change
 		}
-	deriving Show
+	deriving (Show)
 
+data ThreadId = ThreadIdUnknown | ThreadId Concurrent.ThreadId
+	deriving (Show,Eq,Ord)
+
+-- MF TODO: Shouldn't we just have the CallStack as part of Observe?
 data Change
-	= Observe 	!String
+	= Observe 	!String         !ThreadId        !Int      !Identifier
 	| Cons    !Int 	!String
 	| Enter
         | NoEnter
-	| Fun
-	deriving Show
+	| Fun           !CallStack
+	deriving (Show)
 
 startEventStream :: IO ()
 startEventStream = writeIORef events []
@@ -1139,6 +1163,15 @@
 	   ; putMVar sendSem ()
 	   }
 
+
+-- writeEvent :: FilePath -> Event -> IO ()
+-- writeEvent f e = appendFile f (show e)
+-- 
+-- readEvents :: FilePath -> IO [Event]
+-- readEvents f = do
+--   s <- readFile f
+--   return (read s)
+
 -- local
 events :: IORef [Event]
 events = unsafePerformIO $ newIORef badEvents
@@ -1196,316 +1229,47 @@
 %*									*
 %************************************************************************
 
-\begin{code}
-openObserveGlobal :: IO ()
-openObserveGlobal =
-     do { initUniq
-	; startEventStream
-	}
-
-closeObserveGlobal :: IO [Event]
-closeObserveGlobal =
-     do { evs <- endEventStream
-        ; putStrLn ""
-	; return evs
-	}
-\end{code}
+-- \begin{code}
+-- openObserveGlobal :: IO ()
+-- openObserveGlobal =
+--      do { initUniq
+-- 	; startEventStream
+-- 	}
+-- 
+-- closeObserveGlobal :: IO [Event]
+-- closeObserveGlobal =
+--      do { evs <- endEventStream
+--         ; putStrLn ""
+-- 	; return evs
+-- 	}
+-- \end{code}
 
-
 %************************************************************************
 %*									*
-\subsection{The CDS and converting functions}
+\subsection{Simulations}
 %*									*
 %************************************************************************
 
-\begin{code}
-data CDS = CDSNamed String         CDSSet
-	 | CDSCons Int String     [CDSSet]
-	 | CDSFun  Int             CDSSet CDSSet
-	 | CDSEntered Int
-	 | CDSTerminated Int
-	deriving (Show,Eq,Ord)
-
-type CDSSet = [CDS]
-
-
-eventsToCDS :: [Event] -> CDSSet
-eventsToCDS pairs = getChild 0 0
-   where
-     res i = (!) out_arr i
-
-     bnds = (0, length pairs)
-
-     mid_arr :: Array Int [(Int,CDS)]
-     mid_arr = accumArray (flip (:)) [] bnds
-		[ (pnode,(pport,res node))
-	        | (Event node (Parent pnode pport) _) <- pairs
-		]
-
-     out_arr = array bnds	-- never uses 0 index
-	        [ (node,getNode'' node change)
-	 	| (Event node _ change) <- pairs
-		]
-
-     getNode'' ::  Int -> Change -> CDS
-     getNode'' node change =
-       case change of
-	(Observe str) -> CDSNamed str (getChild node 0)
-	(Enter)       -> CDSEntered node
-	(NoEnter)     -> CDSTerminated node
-	(Fun)         -> CDSFun node (getChild node 0) (getChild node 1)
-	(Cons portc cons)
-		      -> CDSCons node cons 
-				[ getChild node n | n <- [0..(portc-1)]]
-
-     getChild :: Int -> Int -> CDSSet
-     getChild pnode pport =
-	[ content
-        | (pport',content) <- (!) mid_arr pnode
-	, pport == pport'
-	]
-
-render  :: Int -> Bool -> CDS -> DOC
-render prec par (CDSCons _ ":" [cds1,cds2]) =
-	if (par && not needParen)  
-	then doc -- dont use paren (..) because we dont want a grp here!
-	else paren needParen doc
-   where
-	doc = grp (brk <> renderSet' 5 False cds1 <> text " : ") <>
-	      renderSet' 4 True cds2
-	needParen = prec > 4
-render prec par (CDSCons _ "," cdss) | length cdss > 0 =
-	nest 2 (text "(" <> foldl1 (\ a b -> a <> text ", " <> b)
-			    (map renderSet cdss) <>
-		text ")")
-render prec par (CDSCons _ name cdss) =
-	paren (length cdss > 0 && prec /= 0)
-	      (nest 2
-	         (text name <> foldr (<>) nil
-			 	[ sep <> renderSet' 10 False cds
-			 	| cds <- cdss 
-			 	]
-		 )
-	      )
-
-{- renderSet handles the various styles of CDSSet.
- -}
-
-renderSet :: CDSSet -> DOC
-renderSet = renderSet' 0 False
-
-renderSet' :: Int -> Bool -> CDSSet -> DOC
-renderSet' _ _      [] = text "_"
-renderSet' prec par [cons@(CDSCons {})]    = render prec par cons
-renderSet' prec par cdss		   = 
-	nest 0 (text "{ " <> foldl1 (\ a b -> a <> line <>
-				    text ", " <> b)
-				    (map renderFn pairs) <>
-	        line <> text "}")
-
-   where
-	pairs = nub (sort (findFn cdss))
-	-- local nub for sorted lists
-	nub []                  = []
-	nub (a:a':as) | a == a' = nub (a' : as)
-        nub (a:as)              = a : nub as
-
-renderFn :: ([CDSSet],CDSSet) -> DOC
-renderFn (args,res) 
-	= grp  (nest 3 
-		(text "\\ " <>
-		 foldr (\ a b -> nest 0 (renderSet' 10 False a) <> sp <> b)
-		       nil
-		       args <> sep <>
-		 text "-> " <> renderSet' 0 False res
-		)
-               )
-
-findFn :: CDSSet -> [([CDSSet],CDSSet)]
-findFn = foldr findFn' []
-
-findFn' (CDSFun _ arg res) rest =
-    case findFn res of
-       [(args',res')] -> (arg : args', res') : rest
-       _              -> ([arg], res) : rest
-findFn' other rest = ([],[other]) : rest
-
-renderTops []   = nil
-renderTops tops = line <> foldr (<>) nil (map renderTop tops)
-
-renderTop :: Output -> DOC
-renderTop (OutLabel str set extras) =
-	nest 2 (text ("-- " ++ str) <> line <>
-		renderSet set
-		<> renderTops extras) <> line
-
-rmEntry :: CDS -> CDS
-rmEntry (CDSNamed str set)   = CDSNamed str (rmEntrySet set)
-rmEntry (CDSCons i str sets) = CDSCons i str (map rmEntrySet sets)
-rmEntry (CDSFun i a b)       = CDSFun i (rmEntrySet a) (rmEntrySet b)
-rmEntry (CDSTerminated i)    = CDSTerminated i
-rmEntry (CDSEntered i)       = error "found bad CDSEntered"
-
-rmEntrySet = map rmEntry . filter noEntered
-  where
-	noEntered (CDSEntered _) = False
-	noEntered _              = True
-
-simplifyCDS :: CDS -> CDS
-simplifyCDS (CDSNamed str set) = CDSNamed str (simplifyCDSSet set)
-simplifyCDS (CDSCons _ "throw" 
-		  [[CDSCons _ "ErrorCall" set]]
-	    ) = simplifyCDS (CDSCons 0 "error" set)
-simplifyCDS cons@(CDSCons i str sets) = 
-	case spotString [cons] of
-	  Just str | not (null str) -> CDSCons 0 (show str) []
-	  _ -> CDSCons 0 str (map simplifyCDSSet sets)
-
-simplifyCDS (CDSFun i a b) = CDSFun 0 (simplifyCDSSet a) (simplifyCDSSet b)
-	-- replace with 
-	-- 	CDSCons i "->" [simplifyCDSSet a,simplifyCDSSet b]
-	-- for turning off the function stuff.
-
-simplifyCDS (CDSTerminated i) = (CDSCons 0 "<?>" [])
-
-simplifyCDSSet = map simplifyCDS 
-
-spotString :: CDSSet -> Maybe String
-spotString [CDSCons _ ":"
-		[[CDSCons _ str []]
-		,rest
-		]
-	   ] 
-	= do { ch <- case reads str of
-	               [(ch,"")] -> return ch
-                       _ -> Nothing
-	     ; more <- spotString rest
-	     ; return (ch : more)
-	     }
-spotString [CDSCons _ "[]" []] = return []
-spotString other = Nothing
-
-paren :: Bool -> DOC -> DOC
-paren False doc = grp (nest 0 doc)
-paren True  doc = grp (nest 0 (text "(" <> nest 0 doc <> brk <> text ")"))
-
-sp :: DOC
-sp = text " "
-
-data Output = OutLabel String CDSSet [Output]
-            | OutData  CDS
-	      deriving (Eq,Ord)
-
-
-commonOutput :: [Output] -> [Output]
-commonOutput = sortBy byLabel
-  where
-     byLabel (OutLabel lab _ _) (OutLabel lab' _ _) = compare lab lab'
+Here we provide stubs for the functionally that is not supported
+by some compilers, and provide some combinators of various flavors.
 
-cdssToOutput :: CDSSet -> [Output]
-cdssToOutput =  map cdsToOutput
+\begin{code}
+ourCatchAllIO :: IO a -> (SomeException -> IO a) -> IO a
+ourCatchAllIO = Exception.catch
 
-cdsToOutput (CDSNamed name cdsset)
-	    = OutLabel name res1 res2
-  where
-      res1 = [ cdss | (OutData cdss) <- res ]
-      res2 = [ out  | out@(OutLabel {}) <- res ]
-      res  = cdssToOutput cdsset
-cdsToOutput cons@(CDSCons {}) = OutData cons
-cdsToOutput    fn@(CDSFun {}) = OutData fn
+handleExc :: Parent -> SomeException -> IO a
+handleExc context exc = return (send "throw" (return throw << exc) context)
 \end{code}
 
-
-
 %************************************************************************
-%*									*
-\subsection{A Pretty Printer}
-%*									*
-%************************************************************************
 
-This pretty printer is based on Wadler's pretty printer.
-
 \begin{code}
-data DOC		= NIL			-- nil	  
-			| DOC :<> DOC		-- beside 
-			| NEST Int DOC
-			| TEXT String
-			| LINE			-- always "\n"
-			| SEP			-- " " or "\n"
-			| BREAK			-- ""  or "\n"
-			| DOC :<|> DOC		-- choose one
-			deriving (Eq,Show)
-data Doc		= Nil
-			| Text Int String Doc
-			| Line Int Int Doc
-			deriving (Show,Eq)
-
-
-mkText			:: String -> Doc -> Doc
-mkText s d		= Text (toplen d + length s) s d
-
-mkLine			:: Int -> Doc -> Doc
-mkLine i d		= Line (toplen d + i) i d
-
-toplen			:: Doc -> Int
-toplen Nil		= 0
-toplen (Text w s x)	= w
-toplen (Line w s x)	= 0
-
-nil			= NIL
-x <> y			= x :<> y
-nest i x		= NEST i x
-text s 			= TEXT s
-line			= LINE
-sep			= SEP
-brk			= BREAK
-
-fold x			= grp (brk <> x)
-
-grp 			:: DOC -> DOC
-grp x			= 
-	case flatten x of
-	  Just x' -> x' :<|> x
-	  Nothing -> x
-
-flatten 		:: DOC -> Maybe DOC
-flatten	NIL		= return NIL
-flatten (x :<> y)	= 
-	do x' <- flatten x
-	   y' <- flatten y
-	   return (x' :<> y')
-flatten (NEST i x)	= 
-	do x' <- flatten x
-	   return (NEST i x')
-flatten (TEXT s)	= return (TEXT s)
-flatten LINE		= Nothing		-- abort
-flatten SEP		= return (TEXT " ")	-- SEP is space
-flatten BREAK		= return NIL		-- BREAK is nil
-flatten (x :<|> y)	= flatten x
-
-layout 			:: Doc -> String
-layout Nil		= ""
-layout (Text _ s x)	= s ++ layout x
-layout (Line _ i x)	= '\n' : replicate i ' ' ++ layout x
-
-best w k doc = be w k [(0,doc)]
-
-be 			:: Int -> Int -> [(Int,DOC)] -> Doc
-be w k []		= Nil
-be w k ((i,NIL):z)	= be w k z
-be w k ((i,x :<> y):z)	= be w k ((i,x):(i,y):z)
-be w k ((i,NEST j x):z) = be w k ((k+j,x):z)
-be w k ((i,TEXT s):z)	= s `mkText` be w (k+length s) z
-be w k ((i,LINE):z)	= i `mkLine` be w i z
-be w k ((i,SEP):z)	= i `mkLine` be w i z
-be w k ((i,BREAK):z)	= i `mkLine` be w i z
-be w k ((i,x :<|> y):z) = better w k 
-				(be w k ((i,x):z))
-				(be w k ((i,y):z))
+(*>>=) :: Monad m => m a -> (Identifier -> (a -> m b, Int)) -> (m b, Identifier)
+x *>>= f = let (g,i) = f UnknownId in (x >>= g,InSequenceAfter i)
 
-better			:: Int -> Int -> Doc -> Doc -> Doc
-better w k x y		= if (w-k) >= toplen x then x else y
+(>>==) :: Monad m => (m a, Identifier) -> (Identifier -> (a -> m b, Int)) -> (m b, Identifier)
+(x,d) >>== f = let (g,i) = f d in (x >>= g,InSequenceAfter i)
 
-pretty			:: Int -> DOC -> String
-pretty w x		= layout (best w 0 x)
+(>>=*) :: Monad m => (m a, Identifier) -> (Identifier -> (a -> m b, Int)) -> m b
+(x,d) >>=* f = let (g,i) = f d in x >>= g
 \end{code}
diff --git a/Debug/Hoed/Render.hs b/Debug/Hoed/Render.hs
new file mode 100644
--- /dev/null
+++ b/Debug/Hoed/Render.hs
@@ -0,0 +1,627 @@
+-- This file is part of the Haskell debugger Hoed.
+--
+-- Copyright (c) Maarten Faddegon, 2014
+
+module Debug.Hoed.Render
+(CompStmt(..)
+,renderCompStmts
+,byStack
+,showWithStack
+
+,CompGraph(..)
+,Vertex(..)
+,mkGraph
+
+,CDS
+,eventsToCDS
+,rmEntrySet
+,simplifyCDSSet
+,isRoot
+)
+where
+
+import Prelude hiding(lookup)
+import Debug.Hoed.Observe
+import Data.List(sort,sortBy,partition,nub)
+import Data.Graph.Libgraph
+import Data.Array as Array
+import Data.Tree.RBTree(RBTree(..),insertOrd,emptyRB,search)
+
+head' :: String -> [a] -> a
+head' msg [] = error msg
+head' _   xs = head xs
+
+------------------------------------------------------------------------
+-- Render equations from CDS set
+
+renderCompStmts :: CDSSet -> [CompStmt]
+renderCompStmts = map renderCompStmt
+
+renderCompStmt :: CDS -> CompStmt
+renderCompStmt (CDSNamed name threadId identifier dependsOn set)
+  = CompStmt name threadId identifier dependsOn equation hstack
+  where equation    = pretty 120 (commas doc)
+        (doc,stacks)= unzip rendered
+        rendered    = map (renderNamedTop name) output
+        output      = cdssToOutput set
+        commas [d]  = d
+        commas ds   = (foldl (\acc d -> acc <> d <> text ", ") (text "{") ds) <> text "}"
+        hstack      = case stacks of
+                        []    -> []
+                        (x:_) -> x
+                        
+
+-- renderCompStmt _ = CompStmt "??" ThreadIdUnknown (-1) UnknownId "??" emptyStack
+
+renderNamedTop :: String -> Output -> (DOC,CallStack)
+renderNamedTop name (OutData cds)
+  = ( nest 2 $ foldl1 (\ a b -> a <> line <> text ", " <> b) (map (renderNamedFn name) pairs)
+    , callStack
+    )
+  where (pairs',callStack) = findFn [cds] 
+        pairs           = (nub . (sort)) pairs'
+	-- local nub for sorted lists
+	nub []                  = []
+	nub (a:a':as) | a == a' = nub (a' : as)
+        nub (a:as)              = a : nub as
+
+renderCallStack :: CallStack -> DOC
+renderCallStack s
+  =  text "With call stack: ["
+  <> foldl1 (\a b -> a <> text ", " <> b) 
+            (map text s)
+  <> text "]"
+
+------------------------------------------------------------------------
+-- The CompStmt type
+
+data CompStmt = CompStmt {equLabel :: String, equThreadId :: ThreadId
+                         , equIdentifier :: Int, equDependsOn :: Identifier
+                         , equRes :: String, equStack :: CallStack}
+                deriving (Eq, Ord)
+
+instance Show CompStmt where
+  show e = equRes e -- ++ " with stack " ++ show (equStack e)
+  showList eqs eq = unlines (map show eqs) ++ eq
+
+showWithStack :: [CompStmt] -> String
+showWithStack eqs = unlines (map show' eqs)
+  where show' eq
+         = equRes eq ++ "\n\tWith call stack:   " ++ showStack (equStack eq)
+                     ++ "\n\tNext stack:        " ++ showStack (nextStack eq)
+                     ++ "\n\tThread id:         " ++ show      (equThreadId eq)
+                     ++ "\n\tMy Obs id:         " ++ show      (equIdentifier eq)
+                     ++ "\n\tDepends on Obs id: " ++ show      (equDependsOn eq)
+           where showStack [] = "[-]"
+                 showStack ss = (foldl (\s' s -> s' ++ s ++ ",") "[" ss) ++ "-]"
+
+-- Compare equations by stack
+byStack e1 e2
+    = case compareStack (equStack e1) (equStack e2) of
+        EQ -> compare (equLabel e1) (equLabel e2)
+        d  -> d
+
+compareStack s1 s2
+  | l1 < l2  = LT
+  | l1 > l2  = GT
+  | l1 == l2 = c (zip s1 s2)
+  where l1 = length s1
+        l2 = length s2
+        c []         = EQ
+        c ((x,y):ss) = case compare x y of
+          EQ -> c ss
+          d  -> d
+              
+------------------------------------------------------------------------
+-- Stack matching
+
+-- nextStack = case getPushMode of
+--         Vanilla  -> nextStack_vanilla
+--         Drop     -> nextStack_drop
+--         Truncate -> nextStack_truncate
+nextStack = nextStack_truncate
+
+-- Always push onto top of stack
+nextStack_vanilla :: CompStmt -> CallStack
+nextStack_vanilla (CompStmt cc _ _ _ _ ccs) = cc:ccs
+
+-- Drop on recursion
+nextStack_drop :: CompStmt -> CallStack
+nextStack_drop (CompStmt cc _ _ _ _ [])   = [cc]
+nextStack_drop (CompStmt cc _ _ _ _ ccs)
+  = if ccs `contains` cc 
+        then ccs
+        else cc:ccs
+
+-- Remove everything between recursion (e.g. [f,g,f,h] becomes [f,h])
+nextStack_truncate :: CompStmt -> CallStack
+nextStack_truncate (CompStmt cc _ _ _ _ [])   = [cc]
+nextStack_truncate (CompStmt cc _ _ _ _ ccs)
+  = if ccs `contains` cc 
+        then dropWhile (/= cc) ccs
+        else cc:ccs
+
+contains :: CallStack -> String -> Bool
+contains ccs cc = filter (== cc) ccs /= []
+
+call :: CallStack -> CallStack -> CallStack
+call sApp sLam = sLam' ++ sApp
+  where (sPre,sApp',sLam') = commonPrefix sApp sLam
+
+commonPrefix :: CallStack -> CallStack -> (CallStack, CallStack, CallStack)
+commonPrefix sApp sLam
+  = let (sPre,sApp',sLam') = span2 (==) (reverse sApp) (reverse sLam)
+    in (sPre, reverse sApp', reverse sLam') 
+
+span2 :: (a -> a -> Bool) -> [a] -> [a] -> ([a], [a], [a])
+span2 f = s f []
+  where s _ pre [] ys = (pre,[],ys)
+        s _ pre xs [] = (pre,xs,[])
+        s f pre xs@(x:xs') ys@(y:ys') 
+          | f x y     = s f (x:pre) xs' ys'
+          | otherwise = (pre,xs,ys)
+
+------------------------------------------------------------------------
+-- Bags are collections of computation statements with the same stack
+
+data Bag = Bag {bagStack :: CallStack, bagStmts :: [CompStmt]}
+
+instance Eq  Bag where b1 == b2 = bagStack b1 == bagStack b2
+instance Ord Bag where compare b1 b2 = cmpStk (bagStack b1) (bagStack b2)
+
+bag :: (CompStmt -> CallStack) -> CompStmt -> Bag
+bag s c = Bag (s c) [c]
+
+(+++) :: CompStmt -> Bag -> Bag
+c +++ b = b{bagStmts = c : bagStmts b}
+
+
+mkBags :: (CompStmt -> CallStack) -> [CompStmt] -> [Bag]
+mkBags _ []  = []
+mkBags s cs = mkBags' (bag s fc) [] ocs
+
+  where (fc:ocs) = sortBy (\c1 c2 -> cmpStk (s c1) (s c2)) cs
+
+        mkBags' b bs []     = b:bs
+        mkBags' b bs (c:cs)
+          | bagStack b == s c = mkBags' (c +++ b) bs     cs
+          | otherwise        = mkBags' (bag s c) (b:bs) cs
+
+------------------------------------------------------------------------
+-- RB trees to speed up computation graph construction
+
+type Tree = RBTree Bag
+
+mkTree :: (CompStmt -> CallStack) -> [CompStmt] -> Tree
+mkTree s cs = foldl insertOrd emptyRB (mkBags s cs)
+
+mkTrees :: [CompStmt] -> (Tree,Tree)
+mkTrees cs = (mkTree equStack cs, mkTree nextStack cs)
+
+
+cmpStk :: CallStack -> CallStack -> Ordering
+cmpStk [] [] = EQ
+cmpStk s1 s2 = case compare (length s1) (length s2) of
+                EQ  -> compare (head s1) (head s2)
+                ord -> ord
+
+lookup :: Tree -> CallStack -> [CompStmt]
+lookup t s = case search (\s b -> cmpStk s (bagStack b)) t s of
+               (Just b) -> bagStmts b
+               Nothing  -> []
+
+------------------------------------------------------------------------
+-- Inverse call
+
+stmts :: Tree -> (CallStack,CallStack) -> [(CompStmt,CompStmt)]
+stmts t (s1,s2) = flattenStmts (lookup t s1, lookup t s2)
+
+flattenStmts :: ([a],[b]) -> [(a,b)]
+flattenStmts (xs,ys) = foldl (\zs x->foldl (\zs' y->(x,y) : zs') zs ys) [] xs
+
+lacc :: CallStack -> [(CallStack,CallStack)]
+lacc = expand . split
+
+expand :: [([a],[a])] -> [([a],[a])]
+expand xs = foldl (\ys x -> ys ++ map (cat $ snd x) (expand' x)) [] xs
+
+  where expand' (xs,[])   = [(xs,[])]
+        expand' (xs,y:ys) = (xs,y:ys) : expand' (xs,ys)
+
+        cat sApp (xs,ys) = (sApp,xs++ys)
+
+split :: [a] -> [([a],[a])]
+split []     = []
+split (x:xs) = split' [x] xs []
+
+  where split' _  []     zs = zs
+        split' xs (y:ys) zs = split' (xs++[y]) ys ((xs,y:ys):zs)
+
+------------------------------------------------------------------------
+-- Computation graphs
+
+data Vertex = Root | Vertex {equations :: [CompStmt], status :: Judgement}
+              deriving (Eq,Show,Ord)
+
+type CompGraph = Graph Vertex ()
+
+isRoot Root = True
+isRoot _    = False
+
+pushDeps :: (Tree,Tree) -> [CompStmt] -> [Arc CompStmt ()]
+pushDeps ts cs = concat (map (pushArcs ts) cs)
+
+pushArcs :: (Tree,Tree) -> CompStmt -> [Arc CompStmt ()]
+pushArcs t p = map (\c -> p ==> c) (pushers t p)
+  where src ==> tgt = Arc src tgt ()
+
+pushers :: (Tree,Tree) -> CompStmt -> [CompStmt]
+pushers (ts,tn) c = lookup ts (nextStack c)
+
+callDeps :: (Tree,Tree) -> [CompStmt] -> [Arc CompStmt ()]
+callDeps (_,t) cs = concat (map (callDep t) cs)
+
+callDep :: Tree -> CompStmt -> [Arc CompStmt ()]
+callDep t c3 = foldl (\as (c2,c1) -> c1 ==> c2 : c2 ==> c3 : as) []
+                          (concat (map (stmts t) (lacc $ equStack c3)))
+  where src ==> tgt = Arc src tgt ()
+
+mkGraph :: [CompStmt] -> CompGraph
+mkGraph cs = {-# SCC "mkGraph" #-} (dagify merge) 
+                                   . addRoot 
+                                   . toVertices 
+                                   . sameThread 
+                                   . filterDependsJustOn
+                                   . addSequenceDependencies
+                                   . nubArcs
+                                   $ g
+  where g :: Graph CompStmt ()
+        g = let ts = mkTrees cs in Graph (head' msg cs) cs (pushDeps ts cs ++ callDeps ts cs)
+        msg = "mkGraph: No computation statements to construct graph from!"
+
+        nubArcs :: Graph CompStmt () -> Graph CompStmt ()
+        nubArcs (Graph r vs as) = Graph r vs (nub as)
+
+        sameThread :: Graph CompStmt () -> Graph CompStmt ()
+        sameThread (Graph r vs as) = Graph r vs (filter (sameThread') as)
+        sameThread' (Arc v w _)
+          | equThreadId v == ThreadIdUnknown 
+            || equThreadId w == ThreadIdUnknown
+            || equThreadId v == equThreadId w   = True
+          | otherwise                           = False
+
+        filterDependsJustOn :: Graph CompStmt () -> Graph CompStmt ()
+        filterDependsJustOn (Graph r vs as) = Graph r vs (filter (filterDependsJustOn') as)
+        filterDependsJustOn' (Arc v w _) = case equDependsOn w of
+          (DependsJustOn i) -> i == equIdentifier v
+          _                 -> True
+
+        addSequenceDependencies :: Graph CompStmt () -> Graph CompStmt ()
+        addSequenceDependencies (Graph r vs as) = Graph r vs (seqDeps vs ++ as)
+        seqDeps vs = [Arc v w () |v <- vs, w <- vs, seqDep v w]
+        seqDep v w = case equDependsOn w of
+          (InSequenceAfter i) -> i == equIdentifier v
+          _                     -> False
+
+        toVertices :: Graph CompStmt () -> CompGraph
+        toVertices = mapGraph (\s->Vertex [s] Unassessed)
+
+        addRoot :: CompGraph -> CompGraph
+        addRoot (Graph _ vs as) =
+                let rs = filter (\(Vertex (s:_) _) -> equStack s == []) vs
+                    es = map (\r -> Root ==> r) rs
+                in  Graph Root (Root : vs) (es ++ as)
+
+        merge :: [Vertex] -> Vertex
+        merge vs = let v = head' msgvs vs; cs' = map equations vs
+                   in v{equations=foldl (++) [] cs'}
+        msgvs = "mkGraph.merge: No vertices to merge."
+
+        src ==> tgt = Arc src tgt ()
+
+-- %************************************************************************
+-- %*									*
+-- \subsection{The CDS and converting functions}
+-- %*									*
+-- %************************************************************************
+
+
+data CDS = CDSNamed      String ThreadId Int Identifier CDSSet
+	 | CDSCons       Int    String   [CDSSet]
+	 | CDSFun        Int             CDSSet CDSSet CallStack
+	 | CDSEntered    Int
+	 | CDSTerminated Int
+	deriving (Show,Eq,Ord)
+
+type CDSSet = [CDS]
+
+eventsToCDS :: [Event] -> CDSSet
+eventsToCDS pairs = getChild 0 0
+   where
+     res i = (!) out_arr i
+
+     bnds = (0, length pairs)
+
+     mid_arr :: Array Int [(Int,CDS)]
+     mid_arr = accumArray (flip (:)) [] bnds
+		[ (pnode,(pport,res node))
+	        | (Event node (Parent pnode pport) _) <- pairs
+		]
+
+     out_arr = array bnds	-- never uses 0 index
+	        [ (node,getNode'' node change)
+	 	| (Event node _ change) <- pairs
+		]
+
+     getNode'' ::  Int -> Change -> CDS
+     getNode'' node change =
+       case change of
+	(Observe str t i d) -> CDSNamed str t i d (getChild node 0)
+	(Enter)             -> CDSEntered node
+	(NoEnter)           -> CDSTerminated node
+	(Fun str)           -> CDSFun node (getChild node 0) (getChild node 1) str
+	(Cons portc cons)
+		            -> CDSCons node cons 
+			          [ getChild node n | n <- [0..(portc-1)]]
+
+     getChild :: Int -> Int -> CDSSet
+     getChild pnode pport =
+	[ content
+        | (pport',content) <- (!) mid_arr pnode
+	, pport == pport'
+	]
+
+render  :: Int -> Bool -> CDS -> DOC
+render prec par (CDSCons _ ":" [cds1,cds2]) =
+	if (par && not needParen)  
+	then doc -- dont use paren (..) because we dont want a grp here!
+	else paren needParen doc
+   where
+	doc = grp (brk <> renderSet' 5 False cds1 <> text " : ") <>
+	      renderSet' 4 True cds2
+	needParen = prec > 4
+render prec par (CDSCons _ "," cdss) | length cdss > 0 =
+	nest 2 (text "(" <> foldl1 (\ a b -> a <> text ", " <> b)
+			    (map renderSet cdss) <>
+		text ")")
+render prec par (CDSCons _ name cdss) =
+	paren (length cdss > 0 && prec /= 0)
+	      (nest 2
+	         (text name <> foldr (<>) nil
+			 	[ sep <> renderSet' 10 False cds
+			 	| cds <- cdss 
+			 	]
+		 )
+	      )
+
+{- renderSet handles the various styles of CDSSet.
+ -}
+
+renderSet :: CDSSet -> DOC
+renderSet = renderSet' 0 False
+
+renderSet' :: Int -> Bool -> CDSSet -> DOC
+renderSet' _ _      [] = text "_"
+renderSet' prec par [cons@(CDSCons {})]    = render prec par cons
+renderSet' prec par cdss		   = 
+	nest 0 (text "{ " <> foldl1 (\ a b -> a <> line <>
+				    text ", " <> b)
+				    (map (renderFn caller) pairs) <>
+	        line <> text "}")
+
+   where
+	(pairs',caller) = findFn cdss
+        pairs           = (nub . sort) pairs'
+	-- local nub for sorted lists
+	nub []                  = []
+	nub (a:a':as) | a == a' = nub (a' : as)
+        nub (a:as)              = a : nub as
+
+renderFn :: CallStack -> ([CDSSet],CDSSet) -> DOC
+renderFn callStack (args, res)
+	= grp  (nest 3 
+		(text "\\ " <>
+		 foldr (\ a b -> nest 0 (renderSet' 10 False a) <> sp <> b)
+		       nil
+		       args <> sep <>
+		 text "-> " <> renderSet' 0 False res
+		)
+               )
+
+renderNamedFn :: String -> ([CDSSet],CDSSet) -> DOC
+renderNamedFn name (args,res)
+  = grp (nest 3 
+            (  text name <> sep
+            <> foldr (\ a b -> nest 0 (renderSet' 10 False a) <> sp <> b) nil args 
+            <> sep <> text "= " <> renderSet' 0 False res
+            )
+         )
+
+
+-- This is where the call stacks are merged.
+--
+-- MF TODO: It would be beneficial for performance if we would only save the
+-- stack once at the top as we already do in the paper and our semantics test code
+
+findFn :: CDSSet -> ([([CDSSet],CDSSet)], CallStack)
+findFn = foldr findFn' ([],[])
+
+findFn' (CDSFun _ arg res caller) (rest,_) =
+    case findFn res of
+       ([(args',res')],caller') -> if caller' /= [] && caller' /= caller 
+                                   then error "found two different stacks!"
+                                   else ((arg : args', res') : rest, caller)
+       _                        -> (([arg], res) : rest,        caller)
+findFn' other (rest,caller)   =  (([],[other]) : rest,        caller)
+
+renderTops []   = nil
+renderTops tops = line <> foldr (<>) nil (map renderTop tops)
+
+renderTop :: Output -> DOC
+renderTop (OutLabel str set extras) =
+	nest 2 (text ("-- " ++ str) <> line <>
+		renderSet set
+		<> renderTops extras) <> line
+
+rmEntry :: CDS -> CDS
+rmEntry (CDSNamed str t i d set)   = CDSNamed str t i d (rmEntrySet set)
+rmEntry (CDSCons i str sets)       = CDSCons i str (map rmEntrySet sets)
+rmEntry (CDSFun i a b str)         = CDSFun i (rmEntrySet a) (rmEntrySet b) str
+rmEntry (CDSTerminated i)          = CDSTerminated i
+rmEntry (CDSEntered i)             = error "found bad CDSEntered"
+
+rmEntrySet = map rmEntry . filter noEntered
+  where
+	noEntered (CDSEntered _) = False
+	noEntered _              = True
+
+simplifyCDS :: CDS -> CDS
+simplifyCDS (CDSNamed str t i d set) = CDSNamed str t i d (simplifyCDSSet set)
+simplifyCDS (CDSCons _ "throw" 
+		  [[CDSCons _ "ErrorCall" set]]
+	    ) = simplifyCDS (CDSCons 0 "error" set)
+simplifyCDS cons@(CDSCons i str sets) = 
+	case spotString [cons] of
+	  Just str | not (null str) -> CDSCons 0 (show str) []
+	  _ -> CDSCons 0 str (map simplifyCDSSet sets)
+
+simplifyCDS (CDSFun i a b str) = CDSFun 0 (simplifyCDSSet a) (simplifyCDSSet b) str
+
+simplifyCDS (CDSTerminated i) = (CDSCons 0 "<?>" [])
+
+simplifyCDSSet = map simplifyCDS 
+
+spotString :: CDSSet -> Maybe String
+spotString [CDSCons _ ":"
+		[[CDSCons _ str []]
+		,rest
+		]
+	   ] 
+	= do { ch <- case reads str of
+	               [(ch,"")] -> return ch
+                       _ -> Nothing
+	     ; more <- spotString rest
+	     ; return (ch : more)
+	     }
+spotString [CDSCons _ "[]" []] = return []
+spotString other = Nothing
+
+paren :: Bool -> DOC -> DOC
+paren False doc = grp (nest 0 doc)
+paren True  doc = grp (nest 0 (text "(" <> nest 0 doc <> brk <> text ")"))
+
+sp :: DOC
+sp = text " "
+
+data Output = OutLabel String CDSSet [Output]
+            | OutData  CDS
+	      deriving (Eq,Ord,Show)
+
+
+commonOutput :: [Output] -> [Output]
+commonOutput = sortBy byLabel
+  where
+     byLabel (OutLabel lab _ _) (OutLabel lab' _ _) = compare lab lab'
+
+cdssToOutput :: CDSSet -> [Output]
+cdssToOutput =  map cdsToOutput
+
+cdsToOutput (CDSNamed name _ _ _ cdsset)
+	    = OutLabel name res1 res2
+  where
+      res1 = [ cdss | (OutData cdss) <- res ]
+      res2 = [ out  | out@(OutLabel {}) <- res ]
+      res  = cdssToOutput cdsset
+cdsToOutput cons@(CDSCons {}) = OutData cons
+cdsToOutput    fn@(CDSFun {}) = OutData fn
+
+-- %************************************************************************
+-- %*									*
+-- \subsection{A Pretty Printer}
+-- %*									*
+-- %************************************************************************
+
+-- This pretty printer is based on Wadler's pretty printer.
+
+data DOC		= NIL			-- nil	  
+			| DOC :<> DOC		-- beside 
+			| NEST Int DOC
+			| TEXT String
+			| LINE			-- always "\n"
+			| SEP			-- " " or "\n"
+			| BREAK			-- ""  or "\n"
+			| DOC :<|> DOC		-- choose one
+			deriving (Eq,Show)
+data Doc		= Nil
+			| Text Int String Doc
+			| Line Int Int Doc
+			deriving (Show,Eq)
+
+
+mkText			:: String -> Doc -> Doc
+mkText s d		= Text (toplen d + length s) s d
+
+mkLine			:: Int -> Doc -> Doc
+mkLine i d		= Line (toplen d + i) i d
+
+toplen			:: Doc -> Int
+toplen Nil		= 0
+toplen (Text w s x)	= w
+toplen (Line w s x)	= 0
+
+nil			= NIL
+x <> y			= x :<> y
+nest i x		= NEST i x
+text s 			= TEXT s
+line			= LINE
+sep			= SEP
+brk			= BREAK
+
+fold x			= grp (brk <> x)
+
+grp 			:: DOC -> DOC
+grp x			= 
+	case flatten x of
+	  Just x' -> x' :<|> x
+	  Nothing -> x
+
+flatten 		:: DOC -> Maybe DOC
+flatten	NIL		= return NIL
+flatten (x :<> y)	= 
+	do x' <- flatten x
+	   y' <- flatten y
+	   return (x' :<> y')
+flatten (NEST i x)	= 
+	do x' <- flatten x
+	   return (NEST i x')
+flatten (TEXT s)	= return (TEXT s)
+flatten LINE		= Nothing		-- abort
+flatten SEP		= return (TEXT " ")	-- SEP is space
+flatten BREAK		= return NIL		-- BREAK is nil
+flatten (x :<|> y)	= flatten x
+
+layout 			:: Doc -> String
+layout Nil		= ""
+layout (Text _ s x)	= s ++ layout x
+layout (Line _ i x)	= '\n' : replicate i ' ' ++ layout x
+
+best w k doc = be w k [(0,doc)]
+
+be 			:: Int -> Int -> [(Int,DOC)] -> Doc
+be w k []		= Nil
+be w k ((i,NIL):z)	= be w k z
+be w k ((i,x :<> y):z)	= be w k ((i,x):(i,y):z)
+be w k ((i,NEST j x):z) = be w k ((k+j,x):z)
+be w k ((i,TEXT s):z)	= s `mkText` be w (k+length s) z
+be w k ((i,LINE):z)	= i `mkLine` be w i z
+be w k ((i,SEP):z)	= i `mkLine` be w i z
+be w k ((i,BREAK):z)	= i `mkLine` be w i z
+be w k ((i,x :<|> y):z) = better w k 
+				(be w k ((i,x):z))
+				(be w k ((i,y):z))
+
+better			:: Int -> Int -> Doc -> Doc -> Doc
+better w k x y		= if (w-k) >= toplen x then x else y
+
+pretty			:: Int -> DOC -> String
+pretty w x		= layout (best w 0 x)
diff --git a/Hoed.cabal b/Hoed.cabal
--- a/Hoed.cabal
+++ b/Hoed.cabal
@@ -1,8 +1,8 @@
 name:                Hoed
-version:             0.1.0.1
-synopsis:            Debug anything without recompiling everything!
-description:         Lightweight debugging based on the observing of intermediate values. How values are observed can be derived with the Generic Deriving Mechanism, or generated with Template Haskell.
-homepage:            http://maartenfaddegon.nl/pub
+version:             0.2.0
+synopsis:            Lighweight algorithmic debugging based on observing intermediate values and the cost centre stack.
+-- description:         TODO
+homepage:            http://maartenfaddegon.nl
 license:             BSD3
 license-file:        LICENSE
 author:              Maarten Faddegon
@@ -11,49 +11,430 @@
 category:            Debug, Trace
 build-type:          Simple
 cabal-version:       >=1.10
-homepage:            http://maartenfaddegon.nl/pub
 
 flag buildExamples
-    description: Build example executables.
-    default:     False
+  description: Build example executables.
+  default: False
 
+flag validate
+  description: Build validation executables.
+  default: False
+
+
 library
-  exposed-modules:     Debug.Hoed.Observe
-  build-depends:       base >=4.6 && <5, template-haskell >=2.7.0 && <2.10, array
+  exposed-modules:     Debug.Hoed
+  other-modules:       Debug.Hoed.Observe
+                       , Debug.Hoed.Render
+                       , Debug.Hoed.DemoGUI
+  build-depends:       base >=4.6 && <5
+                       , template-haskell
+                       , array, containers
+                       , process
+                       , threepenny-gui
+                       , filepath
+                       , libgraph == 1.4
+                       , RBTree == 0.0.5
+                       , regex-posix
+                       , mtl
+                       , directory
   default-language:    Haskell2010
+  ghc-options:         -O0
 
-Executable hoed-examples-GDM-hello
+
+
+---------------------------------------------------------------------------
+--
+-- A list of example-programs that bind to a debugging session after the
+-- program terminates. After running 'cabal build' these are available to 
+-- experiment with through 'sh run'.
+--
+---------------------------------------------------------------------------
+
+
+Executable hoed-examples-Foldl
   if flag(buildExamples)
-        build-depends: base >= 4.6 && < 5, Hoed
+    build-depends:       base >= 4 && < 5
+                         , Hoed
+                         , threepenny-gui
+                         , filepath
   else
-        buildable: False
-  main-is:             GDM-hello.hs
+    buildable: False
+  main-is:             Foldl.hs
   hs-source-dirs:      examples
   default-language:    Haskell2010
+  ghc-options:         -O0
 
-Executable hoed-examples-TH-hello
+Executable hoed-examples-HeadOnEmpty1
   if flag(buildExamples)
-        build-depends: base >= 4.6 && < 5, Hoed
+    build-depends:       base >= 4 && < 5
+                         , Hoed
+                         , threepenny-gui
+                         , filepath
   else
-        buildable: False
-  main-is:             TH-hello.hs
+    buildable: False
+  main-is:             HeadOnEmpty.hs
   hs-source-dirs:      examples
   default-language:    Haskell2010
+  ghc-options:         -O0
 
-Executable hoed-examples-SternBrocot
+Executable hoed-examples-HeadOnEmpty2
   if flag(buildExamples)
-        build-depends: base >= 4.6 && < 5, Hoed
+    build-depends:       base >= 4 && < 5
+                         , Hoed
+                         , threepenny-gui
+                         , filepath
   else
-        buildable: False
-  main-is:             SternBrocot.lhs
+    buildable: False
+  main-is:             HeadOnEmpty2.hs
   hs-source-dirs:      examples
   default-language:    Haskell2010
+  ghc-options:         -O0
 
-Executable hoed-examples-GDM-selectors
+-- Executable hoed-examples-IOException
+--   build-depends:       base >= 4 && < 5
+--                        , Hoed
+--                        , threepenny-gui
+--                        , filepath
+--                        , hood
+--   main-is:             IOException.hs
+--   hs-source-dirs:      examples
+--   default-language:    Haskell2010
+--   ghc-options:         -O0
+
+Executable hoed-examples-IndirectRecursion
   if flag(buildExamples)
-        build-depends: base >= 4.6 && < 5, Hoed
+    build-depends:       base >= 4 && < 5
+                         , Hoed
+                         , threepenny-gui
+                         , filepath
   else
-        buildable: False
-  main-is:             Selectors.hs
+    buildable: False
+  main-is:             IndirectRecursion.lhs
   hs-source-dirs:      examples
   default-language:    Haskell2010
+  ghc-options:         -O0
+
+Executable hoed-examples-Pretty
+  if flag(buildExamples)
+    build-depends:       base >= 4 && < 5
+                         , Hoed
+                         , threepenny-gui
+                         , filepath
+                         , array
+  else
+    buildable: False
+  main-is:             Pretty.hs
+  hs-source-dirs:      examples
+  default-language:    Haskell2010
+  ghc-options:         -O0
+
+Executable hoed-examples-Example1
+  if flag(buildExamples)
+    build-depends:       base >= 4 && < 5
+                         , Hoed
+                         , threepenny-gui
+                         , filepath
+  else
+    buildable: False
+  main-is:             Example1.hs
+  hs-source-dirs:      examples
+  default-language:    Haskell2010
+  ghc-options:         -O0
+
+-- Executable hoed-examples-Example2
+--   build-depends:       base >= 4 && < 5
+--                        , Hoed
+--                        , threepenny-gui
+--                        , filepath
+--   main-is:             Example2.hs
+--   hs-source-dirs:      examples
+--   default-language:    Haskell2010
+
+Executable hoed-examples-Example3
+  if flag(buildExamples)
+    build-depends:       base >= 4 && < 5
+                         , Hoed
+                         , threepenny-gui
+                         , filepath
+  else
+    buildable: False
+  main-is:             Example3.lhs
+  hs-source-dirs:      examples
+  default-language:    Haskell2010
+  ghc-options:         -O0
+
+Executable hoed-examples-Example4
+  if flag(buildExamples)
+    build-depends:       base >= 4 && < 5
+                         , Hoed
+                         , threepenny-gui
+                         , filepath
+  else
+    buildable: False
+  main-is:             Example4.hs
+  hs-source-dirs:      examples
+  default-language:    Haskell2010
+  ghc-options:         -O0
+
+Executable hoed-examples-Insort1
+  if flag(buildExamples)
+    build-depends:       base >= 4 && < 5
+                         , Hoed
+                         , threepenny-gui
+                         , filepath
+  else
+    buildable: False
+  main-is:             Insort.lhs
+  hs-source-dirs:      examples
+  default-language:    Haskell2010
+  ghc-options:         -O0
+
+Executable hoed-examples-Insort2
+  if flag(buildExamples)
+    build-depends:       base >= 4 && < 5
+                         , Hoed
+                         , threepenny-gui
+                         , filepath
+  else
+    buildable: False
+  main-is:             Insort2.hs
+  hs-source-dirs:      examples
+  default-language:    Haskell2010
+  ghc-options:         -O0
+
+Executable hoed-examples-DoublingServer1
+  if flag(buildExamples)
+    build-depends:       base >= 4 && < 5
+                         , Hoed
+                         , threepenny-gui
+                         , filepath
+                         , network
+  else
+    buildable: False
+  main-is:             DoublingServer.hs
+  hs-source-dirs:      examples
+  default-language:    Haskell2010
+  ghc-options:         -O0
+
+Executable hoed-examples-DoublingServer2
+  if flag(buildExamples)
+    build-depends:       base >= 4 && < 5
+                         , Hoed
+                         , threepenny-gui
+                         , filepath
+                         , network
+  else
+    buildable: False
+  main-is:             DoublingServer2.hs
+  hs-source-dirs:      examples
+  default-language:    Haskell2010
+  ghc-options:         -O0
+
+Executable hoed-examples-DoublingServer3
+  if flag(buildExamples)
+    build-depends:       base >= 4 && < 5
+                         , Hoed
+                         , threepenny-gui
+                         , filepath
+                         , network
+  else
+    buildable: False
+  main-is:             DoublingServer3.hs
+  hs-source-dirs:      examples
+  default-language:    Haskell2010
+  ghc-options:         -O0
+
+Executable hoed-examples-DoublingServer4
+  if flag(buildExamples)
+    build-depends:       base >= 4 && < 5
+                         , Hoed
+                         , threepenny-gui
+                         , filepath
+                         , network
+  else
+    buildable: False
+  main-is:             DoublingServer4.hs
+  hs-source-dirs:      examples
+  default-language:    Haskell2010
+  ghc-options:         -O0
+
+Executable hoed-examples-DoublingServer5
+  if flag(buildExamples)
+    build-depends:       base >= 4 && < 5
+                         , Hoed
+                         , threepenny-gui
+                         , filepath
+                         , network
+  else
+    buildable: False
+  main-is:             DoublingServer5.hs
+  hs-source-dirs:      examples
+  default-language:    Haskell2010
+  ghc-options:         -O0
+
+Executable hoed-examples-Hashmap
+  if flag(buildExamples)
+    build-depends:       base >= 4 && < 5
+                         , Hoed
+                         , threepenny-gui
+                         , filepath
+                         , array
+  else
+    buildable: False
+  main-is:             Hashmap.hs
+  hs-source-dirs:      examples
+  default-language:    Haskell2010
+  ghc-options:         -O0
+
+Executable hoed-examples-Responsibility
+  if flag(buildExamples)
+    build-depends:       base >= 4 && < 5
+                         , Hoed
+                         , threepenny-gui
+                         , filepath
+                         , array
+  else
+    buildable: False
+  main-is:             Responsibility.lhs
+  hs-source-dirs:      examples
+  default-language:    Haskell2010
+  ghc-options:         -O0
+
+Executable hoed-examples-TightRope1
+  if flag(buildExamples)
+    build-depends:       base >= 4 && < 5
+                         , Hoed
+                         , threepenny-gui
+                         , filepath
+  else
+    buildable: False
+  main-is:             TightRope.hs
+  hs-source-dirs:      examples
+  default-language:    Haskell2010
+  ghc-options:         -O0
+
+Executable hoed-examples-TightRope2
+  if flag(buildExamples)
+    build-depends:       base >= 4 && < 5
+                         , Hoed
+                         , threepenny-gui
+                         , filepath
+  else
+    buildable: False
+  main-is:             TightRope2.hs
+  hs-source-dirs:      examples
+  default-language:    Haskell2010
+  ghc-options:         -O0
+
+Executable hoed-examples-TightRope3
+  if flag(buildExamples)
+    build-depends:       base >= 4 && < 5
+                         , Hoed
+                         , threepenny-gui
+                         , filepath
+  else
+    buildable: False
+  main-is:             TightRope3.hs
+  hs-source-dirs:      examples
+  default-language:    Haskell2010
+  ghc-options:         -O0
+
+Executable hoed-examples-AskName
+  if flag(buildExamples)
+    build-depends:       base >= 4 && < 5
+                         , Hoed
+                         , threepenny-gui
+                         , filepath
+  else
+    buildable: False
+  main-is:             AskName.hs
+  hs-source-dirs:      examples
+  default-language:    Haskell2010
+  ghc-options:         -O0
+
+---------------------------------------------------------------------------
+--
+-- A set of tests that instead of binding to a debugging session write the
+-- resulting computation graph to file. Reference files are included in
+-- this repository. To validate execute 'sh test'.
+--
+---------------------------------------------------------------------------
+
+Executable hoed-tests-DoublingServer
+  if flag(validate)
+    build-depends:       base >= 4 && < 5
+                         , Hoed
+                         , threepenny-gui
+                         , filepath
+                         , network
+  else
+    buildable: False
+  main-is:             DoublingServer.hs
+  hs-source-dirs:      tests
+  default-language:    Haskell2010
+  ghc-options:         -O0
+
+Executable hoed-tests-Insort2
+  if flag(validate)
+    build-depends:       base >= 4 && < 5
+                         , Hoed
+                         , threepenny-gui
+                         , filepath
+  else
+    buildable: False
+  main-is:             Insort2.hs
+  hs-source-dirs:      tests
+  default-language:    Haskell2010
+  ghc-options:         -O0
+
+Executable hoed-tests-Example1
+  if flag(validate)
+    build-depends:       base >= 4 && < 5
+                         , Hoed
+                         , threepenny-gui
+                         , filepath
+  else
+    buildable: False
+  main-is:             Example1.hs
+  hs-source-dirs:      tests
+  default-language:    Haskell2010
+  ghc-options:         -O0
+
+Executable hoed-tests-Example3
+  if flag(validate)
+    build-depends:       base >= 4 && < 5
+                         , Hoed
+                         , threepenny-gui
+                         , filepath
+  else
+    buildable: False
+  main-is:             Example3.lhs
+  hs-source-dirs:      tests
+  default-language:    Haskell2010
+  ghc-options:         -O0
+
+Executable hoed-tests-Example4
+  if flag(validate)
+    build-depends:       base >= 4 && < 5
+                         , Hoed
+                         , threepenny-gui
+                         , filepath
+  else
+    buildable: False
+  main-is:             Example4.hs
+  hs-source-dirs:      tests
+  default-language:    Haskell2010
+  ghc-options:         -O0
+
+Executable hoed-tests-IndirectRecursion
+  if flag(validate)
+    build-depends:       base >= 4 && < 5
+                         , Hoed
+                         , threepenny-gui
+                         , filepath
+  else
+    buildable: False
+  main-is:             IndirectRecursion.lhs
+  hs-source-dirs:      tests
+  default-language:    Haskell2010
+  ghc-options:         -O0
diff --git a/LICENSE b/LICENSE
--- a/LICENSE
+++ b/LICENSE
@@ -1,34 +1,30 @@
-The Haskell Object Observation Debugging toolkit (HOOD) is Copyright
-(c) Andy Gill, 2000, (c) The University of Kansas, 2010, 
-(c) Maarten Faddegon, 2013-2014.
+Copyright (c) 2014, Maarten Faddegon
 
-All rights reserved, and is distributed as free software under the
-following license.
+All rights reserved.
 
 Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions
-are met:
+modification, are permitted provided that the following conditions are met:
 
-- Redistributions of source code must retain the above copyright notice,
-this list of conditions and the following disclaimer.
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
 
-- Redistributions in binary form must reproduce the above copyright
-notice, this list of conditions and the following disclaimer in the
-documentation and/or other materials provided with the distribution.
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
 
-- Neither name of the copyright holders nor the names of its
-contributors may be used to endorse or promote products derived from
-this software without specific prior written permission.
+    * Neither the name of Maarten Faddegon nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
 
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND THE CONTRIBUTORS
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
 A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
-HOLDERS OR THE CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
-INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
-BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS
-OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
-ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR
-TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
-USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/examples/AskName.hs b/examples/AskName.hs
new file mode 100644
--- /dev/null
+++ b/examples/AskName.hs
@@ -0,0 +1,29 @@
+{-# LANGUAGE StandaloneDeriving, DeriveGeneric #-}
+
+import Debug.Hoed
+
+data Person = Person { name :: String, age :: Int, city :: String }
+  deriving (Show,Generic)
+
+instance Observable Person
+
+main = runO $ observe "main" 
+        ({-# SCC "main" #-} emptyPerson *>>= getName >>== getAge >>=* getCity >>= print)
+
+emptyPerson :: IO Person
+emptyPerson = return (Person "" 0 "")
+
+getName :: Identifier -> (Person -> IO Person, Int)
+getName d = let (f,i) = observe' "getName" d (\p' -> {-# SCC "getName" #-} getName' p')
+            in (f, i)
+getName' p = getLine >>= \x -> return (p{ name = x })
+
+getAge :: Identifier -> (Person -> IO Person, Int)
+getAge d = let (f,i) = observe' "getAge" d (\p' -> {-# SCC "getAge" #-} getAge' p')
+           in (f, i)
+getAge' p = readLn >>= \x -> return (p{ age = x })
+
+getCity :: Identifier -> (Person -> IO Person, Int)
+getCity d = let (f,i) = observe' "getCity" d (\p' -> {-# SCC "getCity" #-} getCity' p')
+            in (f, i)
+getCity' p = getLine >>= \x -> return (p{ city = x })
diff --git a/examples/DoublingServer.hs b/examples/DoublingServer.hs
new file mode 100644
--- /dev/null
+++ b/examples/DoublingServer.hs
@@ -0,0 +1,74 @@
+-- Based on the TrivialServer-example from Marlow, Parallel and Concurrent
+-- Programming in Haskell
+
+{-# LANGUAGE StandaloneDeriving #-}
+
+import System.IO
+import Network
+import Text.Printf
+import Control.Monad
+import Control.Concurrent
+import Debug.Hoed(observe,Observable(..),runO,send)
+import System.IO.Unsafe
+import Data.List
+
+twotimes :: Integer -> Integer
+twotimes j = (observe "twotimes"
+             ( \i -> {-# SCC "twotimes" #-} 
+                2 + i -- bug: should be 2 * i
+             )) j
+
+double :: String -> String
+double s' = observe "double" 
+            (\s -> {-# SCC "double" #-} show (twotimes (read s :: Integer))) s'
+
+loop h = do
+  line <- hGetLine h
+  if line == "end"
+     then do hPutStrLn h ("Thank you for using the Haskell doubling service.")
+             putStrLn $ "server: Terminated client " ++ show h
+     else do hPutStrLn h (double line)
+             loop h
+
+talk :: Handle -> IO ()
+talk h = do 
+  hSetBuffering h LineBuffering
+  i <- myThreadId
+  hPutStrLn h $ "Welcome on thread " ++ show i
+  loop h
+
+port :: Int
+port = 44444
+
+server :: Int -> Socket -> IO ()
+server = observe "server" (\x sock -> {-# SCC "server" #-} server' x sock)
+  where server' 0 _ = putStrLn "server: Shutting down."
+        server' x sock = do
+          (handle, host, port) <- accept sock
+          printf "server: Accepted connection from %s: %s\n" host (show port)
+          forkFinally (talk handle) (\_ -> hClose handle)
+          server (x-1) sock
+
+client :: Int -> IO ()
+client x = do
+  h <- connectTo "localhost" (PortNumber (fromIntegral port))
+  hSetBuffering h LineBuffering
+  let pr s = putStrLn $ "client-" ++ show x ++ ": " ++ s
+  
+  s <- hGetLine h; pr s -- Get and print the welcome message
+  hPutStrLn h (show x)  -- Send x for doubling to the server
+  s <- hGetLine h; pr s -- Get and print response from server
+  hPutStrLn h "end"     -- Send goodbye message
+  s <- hGetLine h; pr s -- Get and print response from server
+
+main :: IO ()
+main = runO $ withSocketsDo $ do
+  sock <- listenOn (PortNumber (fromIntegral port))
+  printf "server: Listening on port %d.\n" port
+  forkIO (server 2 sock) -- Start server in own thread.
+  client 2               -- Connect with two clients from this thread to the server.
+  client 3
+  threadDelay 1000       -- Give server-thread some time to terminate.
+
+instance Observable Handle where observer h = send (show h) (return h)
+instance Observable Socket where observer s = send "socket" (return s)
diff --git a/examples/DoublingServer2.hs b/examples/DoublingServer2.hs
new file mode 100644
--- /dev/null
+++ b/examples/DoublingServer2.hs
@@ -0,0 +1,75 @@
+-- Based on the TrivialServer-example from Marlow, Parallel and Concurrent
+-- Programming in Haskell
+-- 
+
+{-# LANGUAGE StandaloneDeriving #-}
+
+import System.IO
+import Network
+import Text.Printf
+import Control.Monad
+import Control.Concurrent
+import Debug.Hoed(observeCC,Observable(..),runO,send)
+import System.IO.Unsafe
+import Data.List
+
+twotimes :: Integer -> Integer
+twotimes j = (observeCC "twotimes"
+             ( \i -> {-# SCC "twotimes" #-} 
+                2 + i -- bug: should be 2 * i
+             )) j
+
+double :: String -> String
+double s' = observeCC "double" 
+            (\s -> {-# SCC "double" #-} show (twotimes (read s :: Integer))) s'
+
+loop h = do
+  line <- hGetLine h
+  if line == "end"
+     then do hPutStrLn h ("Thank you for using the Haskell doubling service.")
+             putStrLn $ "server: Terminated client " ++ show h
+     else do hPutStrLn h (double line)
+             loop h
+
+talk :: Handle -> IO ()
+talk h = do 
+  hSetBuffering h LineBuffering
+  i <- myThreadId
+  hPutStrLn h $ "Welcome on thread " ++ show i
+  loop h
+
+port :: Int
+port = 44444
+
+server :: Int -> Socket -> IO ()
+server = observeCC "server" (\x sock -> {-# SCC "server" #-} server' x sock)
+  where server' 0 _ = putStrLn "server: Shutting down."
+        server' x sock = do
+          (handle, host, port) <- accept sock
+          printf "server: Accepted connection from %s: %s\n" host (show port)
+          forkFinally (talk handle) (\_ -> hClose handle)
+          server (x-1) sock
+
+client :: Int -> IO ()
+client x = do
+  h <- connectTo "localhost" (PortNumber (fromIntegral port))
+  hSetBuffering h LineBuffering
+  let pr s = putStrLn $ "client-" ++ show x ++ ": " ++ s
+  
+  s <- hGetLine h; pr s -- Get and print the welcome message
+  hPutStrLn h (show x)  -- Send x for doubling to the server
+  s <- hGetLine h; pr s -- Get and print response from server
+  hPutStrLn h "end"     -- Send goodbye message
+  s <- hGetLine h; pr s -- Get and print response from server
+
+main :: IO ()
+main = runO $ withSocketsDo $ do
+  sock <- listenOn (PortNumber (fromIntegral port))
+  printf "server: Listening on port %d.\n" port
+  forkIO (server 2 sock) -- Start server in own thread.
+  client 2               -- Connect with two clients from this thread to the server.
+  client 3
+  threadDelay 1000       -- Give server-thread some time to terminate.
+
+instance Observable Handle where observer h = send (show h) (return h)
+instance Observable Socket where observer s = send "socket" (return s)
diff --git a/examples/DoublingServer3.hs b/examples/DoublingServer3.hs
new file mode 100644
--- /dev/null
+++ b/examples/DoublingServer3.hs
@@ -0,0 +1,74 @@
+-- Based on the TrivialServer-example from Marlow, Parallel and Concurrent
+-- Programming in Haskell
+
+{-# LANGUAGE StandaloneDeriving #-}
+
+import System.IO
+import Network
+import Text.Printf
+import Control.Monad
+import Control.Concurrent
+import Debug.Hoed(observe,Observable(..),runO,send)
+import System.IO.Unsafe
+import Data.List
+
+twotimes :: Integer -> Integer
+twotimes j = (observe "twotimes"
+             ( \i -> {-# SCC "twotimes" #-} 
+                2 + i -- bug: should be 2 * i
+             )) j
+
+double :: String -> String
+double s' = observe "double" 
+            (\s -> {-# SCC "double" #-} show (twotimes (read s :: Integer))) s'
+
+loop h = do
+  line <- hGetLine h
+  if line == "end"
+     then do hPutStrLn h ("Thank you for using the Haskell doubling service.")
+             putStrLn $ "server: Terminated client " ++ show h
+     else do hPutStrLn h (double line)
+             loop h
+
+talk :: Handle -> IO ()
+talk h = do 
+  hSetBuffering h LineBuffering
+  i <- myThreadId
+  hPutStrLn h $ "Welcome on thread " ++ show i
+  loop h
+
+port :: Int
+port = 44444
+
+server :: Int -> Socket -> IO ()
+server = observe "server" (\x sock -> {-# SCC "server" #-} server' x sock)
+  where server' 0 _ = putStrLn "server: Shutting down."
+        server' x sock = do
+          (handle, host, port) <- accept sock
+          printf "server: Accepted connection from %s: %s\n" host (show port)
+          forkFinally (talk handle) (\_ -> hClose handle)
+          server (x-1) sock
+
+client :: Int -> IO ()
+client x = do
+  h <- connectTo "localhost" (PortNumber (fromIntegral port))
+  hSetBuffering h LineBuffering
+  let pr s = putStrLn $ "client-" ++ show x ++ ": " ++ s
+  
+  s <- hGetLine h; pr s -- Get and print the welcome message
+  hPutStrLn h (show x)  -- Send x for doubling to the server
+  s <- hGetLine h; pr s -- Get and print response from server
+  hPutStrLn h "end"     -- Send goodbye message
+  s <- hGetLine h; pr s -- Get and print response from server
+
+main :: IO ()
+main = runO $ observe "main" $ {-# SCC "main" #-} withSocketsDo $ do
+  sock <- listenOn (PortNumber (fromIntegral port))
+  printf "server: Listening on port %d.\n" port
+  forkIO (server 2 sock) -- Start server in own thread.
+  client 2               -- Connect with two clients from this thread to the server.
+  client 3
+  threadDelay 1000       -- Give server-thread some time to terminate.
+
+instance Observable Handle where observer h = send (show h) (return h)
+instance Observable Socket where observer s = send "socket" (return s)
diff --git a/examples/DoublingServer4.hs b/examples/DoublingServer4.hs
new file mode 100644
--- /dev/null
+++ b/examples/DoublingServer4.hs
@@ -0,0 +1,74 @@
+-- Based on the TrivialServer-example from Marlow, Parallel and Concurrent
+-- Programming in Haskell
+
+{-# LANGUAGE StandaloneDeriving #-}
+
+import System.IO
+import Network
+import Text.Printf
+import Control.Monad
+import Control.Concurrent
+import Debug.Hoed(observe,observeCC,Observable(..),runO,send)
+import System.IO.Unsafe
+import Data.List
+
+twotimes :: Integer -> Integer
+twotimes j = (observeCC "twotimes"
+             ( \i -> {-# SCC "twotimes" #-} 
+                2 + i -- bug: should be 2 * i
+             )) j
+
+double :: String -> String
+double s' = observeCC "double" 
+            (\s -> {-# SCC "double" #-} show (twotimes (read s :: Integer))) s'
+
+loop h = do
+  line <- hGetLine h
+  if line == "end"
+     then do hPutStrLn h ("Thank you for using the Haskell doubling service.")
+             putStrLn $ "server: Terminated client " ++ show h
+     else do hPutStrLn h (double line)
+             loop h
+
+talk :: Handle -> IO ()
+talk h = do 
+  hSetBuffering h LineBuffering
+  i <- myThreadId
+  hPutStrLn h $ "Welcome on thread " ++ show i
+  loop h
+
+port :: Int
+port = 44444
+
+server :: Int -> Socket -> IO ()
+server = observeCC "server" (\x sock -> {-# SCC "server" #-} server' x sock)
+  where server' 0 _ = putStrLn "server: Shutting down."
+        server' x sock = do
+          (handle, host, port) <- accept sock
+          printf "server: Accepted connection from %s: %s\n" host (show port)
+          forkFinally (talk handle) (\_ -> hClose handle)
+          server (x-1) sock
+
+client :: Int -> IO ()
+client x = do
+  h <- connectTo "localhost" (PortNumber (fromIntegral port))
+  hSetBuffering h LineBuffering
+  let pr s = putStrLn $ "client-" ++ show x ++ ": " ++ s
+  
+  s <- hGetLine h; pr s -- Get and print the welcome message
+  hPutStrLn h (show x)  -- Send x for doubling to the server
+  s <- hGetLine h; pr s -- Get and print response from server
+  hPutStrLn h "end"     -- Send goodbye message
+  s <- hGetLine h; pr s -- Get and print response from server
+
+main :: IO ()
+main = runO $ observe "main" $ {-# SCC "main" #-} withSocketsDo $ do
+  sock <- listenOn (PortNumber (fromIntegral port))
+  printf "server: Listening on port %d.\n" port
+  forkIO (server 2 sock) -- Start server in own thread.
+  client 2               -- Connect with two clients from this thread to the server.
+  client 3
+  threadDelay 1000       -- Give server-thread some time to terminate.
+
+instance Observable Handle where observer h = send (show h) (return h)
+instance Observable Socket where observer s = send "socket" (return s)
diff --git a/examples/DoublingServer5.hs b/examples/DoublingServer5.hs
new file mode 100644
--- /dev/null
+++ b/examples/DoublingServer5.hs
@@ -0,0 +1,75 @@
+-- Based on the TrivialServer-example from Marlow, Parallel and Concurrent
+-- Programming in Haskell
+
+{-# LANGUAGE StandaloneDeriving #-}
+
+import System.IO
+import Network
+import Text.Printf
+import Control.Monad
+import Control.Concurrent
+import Debug.Hoed(observe,Observable(..),runO,send,observe',Identifier(..))
+import System.IO.Unsafe
+import Data.List
+
+twotimes :: Int -> Integer -> Integer
+twotimes d j = (fst $ observe' "twotimes" (DependsJustOn d)
+               ( \i -> {-# SCC "twotimes" #-} 
+                  2 + i -- bug: should be 2 * i
+               )) j
+
+double :: String -> String
+double s' = let (res,d) = observe' "double" UnknownId
+                          (\s -> {-# SCC "double" #-} show (twotimes d (read s :: Integer)))
+            in res s'
+
+loop h = do
+  line <- hGetLine h
+  if line == "end"
+     then do hPutStrLn h ("Thank you for using the Haskell doubling service.")
+             putStrLn $ "server: Terminated client " ++ show h
+     else do hPutStrLn h (double line)
+             loop h
+
+talk :: Handle -> IO ()
+talk h = do 
+  hSetBuffering h LineBuffering
+  i <- myThreadId
+  hPutStrLn h $ "Welcome on thread " ++ show i
+  loop h
+
+port :: Int
+port = 44444
+
+server :: Int -> Socket -> IO ()
+server = observe "server" (\x sock -> {-# SCC "server" #-} server' x sock)
+  where server' 0 _ = putStrLn "server: Shutting down."
+        server' x sock = do
+          (handle, host, port) <- accept sock
+          printf "server: Accepted connection from %s: %s\n" host (show port)
+          forkFinally (talk handle) (\_ -> hClose handle)
+          server (x-1) sock
+
+client :: Int -> IO ()
+client x = do
+  h <- connectTo "localhost" (PortNumber (fromIntegral port))
+  hSetBuffering h LineBuffering
+  let pr s = putStrLn $ "client-" ++ show x ++ ": " ++ s
+  
+  s <- hGetLine h; pr s -- Get and print the welcome message
+  hPutStrLn h (show x)  -- Send x for doubling to the server
+  s <- hGetLine h; pr s -- Get and print response from server
+  hPutStrLn h "end"     -- Send goodbye message
+  s <- hGetLine h; pr s -- Get and print response from server
+
+main :: IO ()
+main = runO $ withSocketsDo $ do
+  sock <- listenOn (PortNumber (fromIntegral port))
+  printf "server: Listening on port %d.\n" port
+  forkIO (server 2 sock) -- Start server in own thread.
+  client 2               -- Connect with two clients from this thread to the server.
+  client 3
+  threadDelay 1000       -- Give server-thread some time to terminate.
+
+instance Observable Handle where observer h = send (show h) (return h)
+instance Observable Socket where observer s = send "socket" (return s)
diff --git a/examples/Example1.hs b/examples/Example1.hs
new file mode 100644
--- /dev/null
+++ b/examples/Example1.hs
@@ -0,0 +1,9 @@
+import Debug.Hoed
+
+f :: Int -> Int
+f = observe "f" $ \x -> {-# SCC "f" #-} if x > 0 then g x else 0
+
+g :: Int -> Int
+g = observe "g" $ \x -> {-# SCC "g" #-} x `div` 2
+
+main = runO $ print ((f 2) + (f 0))
diff --git a/examples/Example3.lhs b/examples/Example3.lhs
new file mode 100644
--- /dev/null
+++ b/examples/Example3.lhs
@@ -0,0 +1,27 @@
+> {-# LANGUAGE TemplateHaskell, Rank2Types #-}
+> import Debug.Hoed
+
+> $(observedTypes "k" [])
+> $(observedTypes "l" [])
+> $(observedTypes "m" [])
+> $(observedTypes "n" [])
+
+
+> main = runO $ print (k 1)
+
+> k :: Int -> Int
+> k  x = $(observeTempl "k") k' x
+> k' x = {-# SCC "k" #-} k'' x
+> k'' x = (l x) + (m $ x + 1)
+
+> l :: Int -> Int
+> l  x  = $(observeTempl "l") l' x
+> l' x  = {-# SCC "l" #-} m x
+
+> m :: Int -> Int
+> m  x = $(observeTempl "m") m' x
+> m' x = {-# SCC "m" #-} n x
+
+> n :: Int -> Int
+> n  x = $(observeTempl "n") n' x
+> n' x = {-# SCC "n" #-} x
diff --git a/examples/Example4.hs b/examples/Example4.hs
new file mode 100644
--- /dev/null
+++ b/examples/Example4.hs
@@ -0,0 +1,3 @@
+import Debug.Hoed
+
+main = runO $ print (observe "main" $ 42 :: Int)
diff --git a/examples/Foldl.hs b/examples/Foldl.hs
new file mode 100644
--- /dev/null
+++ b/examples/Foldl.hs
@@ -0,0 +1,32 @@
+-- Foldl is an example of a higher order function with state (sometimes called
+-- the accumulator). 
+--
+-- In this example we demonstrate how a combination of wrapping 
+-- the higher order function "foldl" and transforming the callee "g"
+-- gives us a notion of order between the callee-observations.
+
+import Prelude hiding (foldl)
+import qualified Prelude
+import Debug.Hoed(printO,observe,observe',Identifier(..),Observable)
+
+-- Prelude.foldl :: (b -> a -> b) -> b [a] -> b
+
+foldl :: (Observable a, Observable b) => ((b,Identifier) -> a -> (b,Int)) -> b -> [a] -> b
+foldl fn z = observe "foldl" 
+               (\xs -> fst $ {-# SCC "foldl" #-} Prelude.foldl fn' (z,UnknownId) xs)
+  where fn' a x = let (r,i) = fn a x in (r,InSequenceAfter i)
+
+-- g :: Int -> Int -> Int
+-- g x y = x + y
+
+g :: (Int,Identifier) -> Int -> (Int,Int)
+g (a1,id) a2 = let (fn,i) = observe' "g" id (\a1' a2' -> {-# SCC "g" #-} g_orig a1' a2')
+               in (fn a1 a2,i)
+
+  where g_orig x y = x + y
+
+f :: [Int] -> Int
+f xs = foldl g 10 xs
+
+main :: IO ()
+main = printO (f [1,2,3])
diff --git a/examples/GDM-hello.hs b/examples/GDM-hello.hs
deleted file mode 100644
--- a/examples/GDM-hello.hs
+++ /dev/null
@@ -1,17 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-import Debug.Hoed.Observe
-
-data T = Hello | World deriving Generic
-instance Observable T
-
-f :: T -> T
-f Hello = World
-f World = Hello
-
-p :: T -> String
-p Hello = "Hello"
-p World = "world"
-
-
-main = runO . putStrLn $ (p . f')  Hello
-  where f' = gdmobserve "f" f
diff --git a/examples/Hashmap.hs b/examples/Hashmap.hs
new file mode 100644
--- /dev/null
+++ b/examples/Hashmap.hs
@@ -0,0 +1,102 @@
+{-# LANGUAGE DeriveGeneric #-}
+import Prelude hiding (lookup,insert)
+import Data.Maybe (fromJust)
+import Debug.Hoed
+
+--------------------------------------------------------------------------------
+
+data Hashmap a = Hashmap Int [(Maybe a)] deriving Generic
+class Hashable a where hash :: a -> Int
+
+emptyMap :: Int -> Hashmap a
+emptyMap size = Hashmap size $ take size (repeat Nothing)
+
+size :: Hashmap a -> Int
+size (Hashmap s _) = s
+
+(%) :: Int -> Hashmap a -> Int
+idx % hashmap = idx `mod` (size hashmap)
+
+(!!!) :: Hashmap a -> Int -> Maybe a
+(!!!) (Hashmap _ elems) = (!!) elems
+
+(///) :: Hashmap a -> (Int,Maybe a) -> Hashmap a
+(Hashmap size elems) /// e = Hashmap size (elems // e)
+
+(//) :: [a] -> (Int,a) -> [a]
+xs // (idx,x) = take idx xs ++ x : (drop (idx + 1) xs)
+
+add :: (Observable k, Observable v, Hashable k)
+    => (k,v) -> Hashmap (k,v) -> Hashmap (k,v)
+add (key,elem) hashmap
+  = ( -- observe "add"
+      (\(key,elem) hashmap -> {-# SCC "add" #-}
+        let idx = (hash key) `mod` (size hashmap)
+        in insert hashmap idx (key,elem)
+      )
+    ) (key,elem) hashmap
+
+insert :: Hashmap a -> Int -> a -> Hashmap a
+insert hashmap idx x = case hashmap !!! idx of
+      Nothing -> hashmap /// (idx,Just x)
+      _       -> insert hashmap ((idx+1) % hashmap) x
+
+lookup :: (Observable k, Observable v, Eq k, Hashable k) 
+       => k -> Hashmap (k,v) -> Maybe (k,v)
+lookup key hashmap
+  = (observe "lookup"
+      (\key hashmap -> {-# SCC "lookup" #-} 
+        let idx = find hashmap ((hash key) % hashmap) key
+        in fmap (\i -> fromJust $ hashmap !!! i) idx
+      )
+    ) key hashmap
+
+find :: (Observable k, Observable v, Eq k) 
+     => Hashmap (k,v) -> Int -> k -> Maybe Int
+find hashmap idx key 
+  = ( observe "find"
+      (\hashmap idx key -> {-# SCC "find" #-} 
+        case hashmap !!! idx of
+          Nothing            -> Nothing
+          (Just (key',elem)) -> if key == key' 
+                                   then Just idx
+                                   else find hashmap ((idx+1) % hashmap) key
+      )
+    ) hashmap idx key
+
+remove :: (Eq k, Hashable k, Observable k, Observable v)
+       => k -> Hashmap (k,v) -> Hashmap (k,v)
+remove key hashmap 
+  = ( observe "remove"
+      (\key hashmap -> {-# SCC "remove" #-} 
+        case find hashmap ((hash key) % hashmap) key of
+          Nothing  -> hashmap
+          Just idx -> hashmap /// (idx,Nothing)
+      )  
+    ) key hashmap
+
+instance Observable a => Observable (Hashmap a)
+instance Observable Testval
+instance Observable Testkey
+
+--------------------------------------------------------------------------------
+
+data Testkey = One | Two | Three deriving (Eq, Generic)
+data Testval = Wennemars | Kramer | Verheijen deriving (Eq, Generic)
+
+main = runO $ print test
+
+instance Hashable Testkey where
+        hash One   = 10
+        hash Two   = 20
+        hash Three = 30
+
+map1 :: Hashmap (Testkey,Testval)
+map1 = ( (add (Two, Verheijen))
+       . (add (One, Kramer))
+       ) (emptyMap 5)
+
+
+-- test = lookup Two map1 == lookup Two (remove One map1)
+test = (==) (observe "testLeft" $ {-# SCC "testLeft" #-} lookup Two map1 )
+            (observe "testRight" $ {-# SCC "testRight" #-} lookup Two (remove One map1))
diff --git a/examples/HeadOnEmpty.hs b/examples/HeadOnEmpty.hs
new file mode 100644
--- /dev/null
+++ b/examples/HeadOnEmpty.hs
@@ -0,0 +1,12 @@
+import Debug.Hoed
+
+main = printO x
+
+x :: Int
+x = observe "f" ({-# SCC "f" #-} h head xs)
+
+xs :: [Int]
+xs = observe "xs" ({-# SCC "xs" #-} [])
+
+h :: ([Int] -> Int) -> [Int] -> Int
+h = observe "h" (\a' is' -> {-# SCC "h" #-} a' is')
diff --git a/examples/HeadOnEmpty2.hs b/examples/HeadOnEmpty2.hs
new file mode 100644
--- /dev/null
+++ b/examples/HeadOnEmpty2.hs
@@ -0,0 +1,21 @@
+import Debug.Hoed
+import GHC.IO(failIO)
+import Control.Exception(catch,SomeException)
+
+main = runO $ do
+  (print (h xs))     `catch` (handleExc "First one went wrong:")
+  ((f xs) >>= print) `catch` (handleExc "Second one went wrong:")
+
+-- Functions like 'readLn' use failIO. These exception are NOT traced.
+f :: [Int] -> IO Int
+f = observe "f" (\ys -> failIO "Oops from f")
+
+-- Functions like 'head' use error. These exceptions are traced.
+h :: [Int] -> Int
+h = observe "h" (\ys -> error "Oops from h!")
+
+xs :: [Int]
+xs = observe "xs" ({-# SCC "xs" #-} [])
+
+handleExc :: String -> SomeException -> IO ()
+handleExc s e = putStrLn (s ++ show e)
diff --git a/examples/IndirectRecursion.lhs b/examples/IndirectRecursion.lhs
new file mode 100644
--- /dev/null
+++ b/examples/IndirectRecursion.lhs
@@ -0,0 +1,37 @@
+This is an example of how information is lost as a result of trunction of the
+cost centre stack. The actual call graph is of this program is:
+
+        main -> f 1 -> g 2 -> f 3 -> h 1
+
+But with pushing "f" a second time the "g" label is also lost. Additionally
+the h-statement is associated with the stack [f], which can either be from the
+untruncated f statement or the truncated f statement. We therefore infer the
+following call graph:
+
+        main -> f 1 -> {f 3, g 2} -> h 1
+                   \_________________^
+
+> {-# LANGUAGE TemplateHaskell, Rank2Types #-}
+> import Debug.Hoed
+
+> $(observedTypes "f" [])
+> $(observedTypes "g" [])
+> $(observedTypes "h" [])
+
+> f :: Int -> Int
+> f   x = $(observeTempl "f") f' x
+> f'  x = {-# SCC "f" #-} f'' x
+> f'' 1 = g 2
+> f'' x = h (x + 1)
+
+> g :: Int -> Int
+> g   x = $(observeTempl "g") g' x
+> g'  x = {-# SCC "g" #-} g'' x
+> g'' x = f (x + 1)
+
+> h :: Int -> Int
+> h   x = $(observeTempl "h") h' x
+> h'  x = {-# SCC "h" #-} h'' x
+> h'' x = (x+1)
+
+> main = runO $ print (f 1)
diff --git a/examples/Insort.lhs b/examples/Insort.lhs
new file mode 100644
--- /dev/null
+++ b/examples/Insort.lhs
@@ -0,0 +1,28 @@
+Haskell version of the buggy insertion sort as shown in Lee Naish
+A Declarative Debugging Scheme.
+
+> {-# LANGUAGE TemplateHaskell, Rank2Types #-}
+> import Debug.Hoed
+> $(observedTypes "isort"  [[t|forall a . Observable a => [] a|]])
+> $(observedTypes "insert" [[t|forall a . Observable a => [] a|]])
+> $(observedTypes "result" [[t|forall a . Observable a => [] a|]])
+
+Insertion sort.
+
+> isort :: [Int] -> [Int]
+> isort ns = $(observeTempl "isort") (\ns -> {-# SCC "isort" #-} isort' ns) ns
+> isort' []     = []
+> isort' (n:ns) = insert n (isort ns)
+
+Insert number into sorted list.
+
+> insert :: Int -> [Int] -> [Int]
+> insert n ms = ($(observeTempl "insert") (\n ms -> {-# SCC "insert" #-} insert' n ms)) n ms
+> insert' :: Int -> [Int] -> [Int]
+> insert' n []      = [n]
+> insert' n (m:ms)
+>       | n <= m    = n : ms -- bug: `m' is missing in this case
+>       | otherwise = m : (insert n ms)
+
+> main = printO $
+>          $(observeTempl "result") ({-# SCC "result" #-} isort [1,2])
diff --git a/examples/Insort2.hs b/examples/Insort2.hs
new file mode 100644
--- /dev/null
+++ b/examples/Insort2.hs
@@ -0,0 +1,27 @@
+-- Haskell version of the buggy insertion sort as shown in Lee Naish
+-- A Declarative Debugging Scheme.
+--
+-- As Insort1, but with observe rather than templated observers.
+
+{-# LANGUAGE StandaloneDeriving #-}
+import Debug.Hoed
+
+-- Insertion sort.
+
+isort :: [Int] -> [Int]
+isort ns = observe "isort" (\ns -> {-# SCC "isort" #-} isort' ns) ns
+isort' []     = []
+isort' (n:ns) = insert n (isort ns)
+
+-- Insert number into sorted list.
+
+insert :: Int -> [Int] -> [Int]
+insert n ms = (observe "insert" (\n ms -> {-# SCC "insert" #-} insert' n ms)) n ms
+insert' :: Int -> [Int] -> [Int]
+insert' n []      = [n]
+insert' n (m:ms)
+      | n <= m    = n : ms -- bug: `m' is missing in this case
+      | otherwise = m : (insert n ms)
+
+main = printO $
+         (observe "result") ({-# SCC "result" #-} isort [1,2])
diff --git a/examples/Pretty.hs b/examples/Pretty.hs
new file mode 100644
--- /dev/null
+++ b/examples/Pretty.hs
@@ -0,0 +1,424 @@
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE DeriveGeneric #-}
+
+import Data.List(sort,sortBy,partition)
+import Data.Array as Array
+import Debug.Hoed(observe,Observable(..),runO,Generic)
+
+------------------------------------------------------------------------
+-- Make our datatypes observable
+
+instance Observable CDS
+instance Observable DOC
+instance Observable CompStmt
+instance Observable Output
+
+------------------------------------------------------------------------
+-- The main program with the failing testcase.
+
+main = runO $ print (renderCompStmts cdss)
+
+cdss = [CDSNamed "f" [CDSFun 0 [CDSCons 0 "2" []] [CDSCons 0 "1" []] [],CDSFun 0 [CDSCons 0 "0" []] [CDSCons 0 "0" []] []],CDSNamed "g" [CDSFun 0 [CDSCons 0 "2" []] [CDSCons 0 "1" []] ["f"]]]
+
+------------------------------------------------------------------------
+-- Render equations from CDS set
+
+renderCompStmts :: CDSSet -> [CompStmt]
+renderCompStmts = observe "renderCompStmts" ({-# SCC "renderCompStmts" #-} map renderCompStmt)
+
+renderCompStmt :: CDS -> CompStmt
+renderCompStmt c' = observe "renderCompStmt" (\c-> {-# SCC "renderCompStmt" #-} renderCompStmt' c) c'
+renderCompStmt' (CDSNamed name set) = CompStmt name equation (head stack)
+  where equation    = pretty 80 (foldr (<>) nil doc) -- BUG: foldr (<>) just puts equations
+                                                     -- beside eachother, rather than seperating
+                                                     -- them with commas
+        (doc,stack) = unzip rendered
+        rendered    = map (renderNamedTop name) output
+        output      = cdssToOutput set
+        -- MF TODO: Do we want to sort?
+        -- output      = (commonOutput . cdssToOutput) set
+renderCompStmt' _ = CompStmt "??" "??" emptyStack
+
+renderNamedTop :: String -> Output -> (DOC,CallStack)
+renderNamedTop arg1 arg2 = observe "renderNamedTop" 
+                           (\arg1' arg2' -> {-# SCC "renderNamedTop" #-} renderNamedTop' arg1' arg2'
+                           ) arg1 arg2
+renderNamedTop' name (OutData cds)
+  = ( nest 2 $ foldl1 (\ a b -> a <> line <> text ", " <> b) (map (renderNamedFn name) pairs)
+    , callStack
+    )
+  where (pairs',callStack) = findFn [cds] 
+        pairs           = (nub . (sort)) pairs'
+	-- local nub for sorted lists
+	nub []                  = []
+	nub (a:a':as) | a == a' = nub (a' : as)
+        nub (a:as)              = a : nub as
+
+renderCallStack :: CallStack -> DOC
+renderCallStack s
+  =  text "With call stack: ["
+  <> foldl1 (\a b -> a <> text ", " <> b) 
+            (map text s)
+  <> text "]"
+
+------------------------------------------------------------------------
+-- The CompStmt type
+
+data CompStmt = CompStmt {equLabel :: String, equRes :: String, equStack :: CallStack}
+                deriving (Eq, Ord, Generic)
+
+instance Show CompStmt where
+  show e = equRes e -- ++ " with stack " ++ show (equStack e)
+  showList eqs eq = unlines (map show eqs) ++ eq
+
+-- Compare equations by stack
+byStack e1 e2
+    = case compareStack (equStack e1) (equStack e2) of
+        EQ -> compare (equLabel e1) (equLabel e2)
+        d  -> d
+
+compareStack s1 s2
+  | l1 < l2  = LT
+  | l1 > l2  = GT
+  | l1 == l2 = c (zip s1 s2)
+  where l1 = length s1
+        l2 = length s2
+        c []         = EQ
+        c ((x,y):ss) = case compare x y of
+          EQ -> c ss
+          d  -> d
+
+-- The CDS and converting functions
+
+data CDS = CDSNamed String         CDSSet
+	 | CDSCons Int String     [CDSSet]
+	 | CDSFun  Int             CDSSet CDSSet CallStack
+	 | CDSEntered Int
+	 | CDSTerminated Int
+	deriving (Show,Eq,Ord,Generic)
+
+type CDSSet = [CDS]
+
+eventsToCDS :: [Event] -> CDSSet
+eventsToCDS pairs = getChild 0 0
+   where
+     res i = (!) out_arr i
+
+     bnds = (0, length pairs)
+
+     mid_arr :: Array Int [(Int,CDS)]
+     mid_arr = accumArray (flip (:)) [] bnds
+		[ (pnode,(pport,res node))
+	        | (Event node (Parent pnode pport) _) <- pairs
+		]
+
+     out_arr = array bnds	-- never uses 0 index
+	        [ (node,getNode'' node change)
+	 	| (Event node _ change) <- pairs
+		]
+
+     getNode'' ::  Int -> Change -> CDS
+     getNode'' node change =
+       case change of
+	(Observe str) -> CDSNamed str (getChild node 0)
+	(Enter)       -> CDSEntered node
+	(NoEnter)     -> CDSTerminated node
+	(Fun str)     -> CDSFun node (getChild node 0) (getChild node 1) str
+	(Cons portc cons)
+		      -> CDSCons node cons 
+				[ getChild node n | n <- [0..(portc-1)]]
+
+     getChild :: Int -> Int -> CDSSet
+     getChild pnode pport =
+	[ content
+        | (pport',content) <- (!) mid_arr pnode
+	, pport == pport'
+	]
+
+render  :: Int -> Bool -> CDS -> DOC
+render prec par (CDSCons _ ":" [cds1,cds2]) =
+	if (par && not needParen)  
+	then doc -- dont use paren (..) because we dont want a grp here!
+	else paren needParen doc
+   where
+	doc = grp (brk <> renderSet' 5 False cds1 <> text " : ") <>
+	      renderSet' 4 True cds2
+	needParen = prec > 4
+render prec par (CDSCons _ "," cdss) | length cdss > 0 =
+	nest 2 (text "(" <> foldl1 (\ a b -> a <> text ", " <> b)
+			    (map renderSet cdss) <>
+		text ")")
+render prec par (CDSCons _ name cdss) =
+	paren (length cdss > 0 && prec /= 0)
+	      (nest 2
+	         (text name <> foldr (<>) nil
+			 	[ sep <> renderSet' 10 False cds
+			 	| cds <- cdss 
+			 	]
+		 )
+	      )
+
+{- renderSet handles the various styles of CDSSet.
+ -}
+
+renderSet :: CDSSet -> DOC
+renderSet = renderSet' 0 False
+
+renderSet' :: Int -> Bool -> CDSSet -> DOC
+renderSet' _ _      [] = text "_"
+renderSet' prec par [cons@(CDSCons {})]    = render prec par cons
+renderSet' prec par cdss		   = 
+	nest 0 (text "{ " <> foldl1 (\ a b -> a <> line <>
+				    text ", " <> b)
+				    (map (renderFn caller) pairs) <>
+	        line <> text "}")
+
+   where
+	(pairs',caller) = findFn cdss
+        pairs           = (nub . sort) pairs'
+	-- local nub for sorted lists
+	nub []                  = []
+	nub (a:a':as) | a == a' = nub (a' : as)
+        nub (a:as)              = a : nub as
+
+renderFn :: CallStack -> ([CDSSet],CDSSet) -> DOC
+renderFn callStack (args, res)
+	= grp  (nest 3 
+		(text "\\ " <>
+		 foldr (\ a b -> nest 0 (renderSet' 10 False a) <> sp <> b)
+		       nil
+		       args <> sep <>
+		 text "-> " <> renderSet' 0 False res
+		)
+               )
+
+renderNamedFn :: String -> ([CDSSet],CDSSet) -> DOC
+renderNamedFn arg1 arg2 = observe "renderNamedFn" 
+                                (\arg1' arg2' -> {-# SCC "renderNamedFn" #-}
+                                renderNamedFn' arg1' arg2') arg1 arg2
+renderNamedFn' name (args,res)
+  = grp (nest 3 
+            (  text name <> sep
+            <> foldr (\ a b -> nest 0 (renderSet' 10 False a) <> sp <> b) nil args 
+            <> sep <> text "= " <> renderSet' 0 False res
+            )
+         )
+
+
+-- This is where the call stacks are merged.
+--
+-- MF TODO: It would be beneficial for performance if we would only save the
+-- stack once at the top as we already do in the paper and our semantics test code
+
+findFn :: CDSSet -> ([([CDSSet],CDSSet)], CallStack)
+findFn = foldr findFn' ([],[])
+
+findFn' (CDSFun _ arg res caller) (rest,_) =
+    case findFn res of
+       ([(args',res')],caller') -> if caller' /= [] && caller' /= caller 
+                                   then error "found two different stacks!"
+                                   else ((arg : args', res') : rest, caller)
+       _                        -> (([arg], res) : rest,        caller)
+findFn' other (rest,caller)   =  (([],[other]) : rest,        caller)
+
+renderTops []   = nil
+renderTops tops = line <> foldr (<>) nil (map renderTop tops)
+
+renderTop :: Output -> DOC
+renderTop (OutLabel str set extras) =
+	nest 2 (text ("-- " ++ str) <> line <>
+		renderSet set
+		<> renderTops extras) <> line
+
+rmEntry :: CDS -> CDS
+rmEntry (CDSNamed str set)   = CDSNamed str (rmEntrySet set)
+rmEntry (CDSCons i str sets) = CDSCons i str (map rmEntrySet sets)
+rmEntry (CDSFun i a b str)   = CDSFun i (rmEntrySet a) (rmEntrySet b) str
+rmEntry (CDSTerminated i)    = CDSTerminated i
+rmEntry (CDSEntered i)       = error "found bad CDSEntered"
+
+rmEntrySet = map rmEntry . filter noEntered
+  where
+	noEntered (CDSEntered _) = False
+	noEntered _              = True
+
+simplifyCDS :: CDS -> CDS
+simplifyCDS (CDSNamed str set) = CDSNamed str (simplifyCDSSet set)
+simplifyCDS (CDSCons _ "throw" 
+		  [[CDSCons _ "ErrorCall" set]]
+	    ) = simplifyCDS (CDSCons 0 "error" set)
+simplifyCDS cons@(CDSCons i str sets) = 
+	case spotString [cons] of
+	  Just str | not (null str) -> CDSCons 0 (show str) []
+	  _ -> CDSCons 0 str (map simplifyCDSSet sets)
+
+simplifyCDS (CDSFun i a b str) = CDSFun 0 (simplifyCDSSet a) (simplifyCDSSet b) str
+
+simplifyCDS (CDSTerminated i) = (CDSCons 0 "<?>" [])
+
+simplifyCDSSet = map simplifyCDS 
+
+spotString :: CDSSet -> Maybe String
+spotString [CDSCons _ ":"
+		[[CDSCons _ str []]
+		,rest
+		]
+	   ] 
+	= do { ch <- case reads str of
+	               [(ch,"")] -> return ch
+                       _ -> Nothing
+	     ; more <- spotString rest
+	     ; return (ch : more)
+	     }
+spotString [CDSCons _ "[]" []] = return []
+spotString other = Nothing
+
+paren :: Bool -> DOC -> DOC
+paren False doc = grp (nest 0 doc)
+paren True  doc = grp (nest 0 (text "(" <> nest 0 doc <> brk <> text ")"))
+
+sp :: DOC
+sp = text " "
+
+data Output = OutLabel String CDSSet [Output]
+            | OutData  CDS
+	      deriving (Eq,Ord,Show,Generic)
+
+
+commonOutput :: [Output] -> [Output]
+commonOutput = sortBy byLabel
+  where
+     byLabel (OutLabel lab _ _) (OutLabel lab' _ _) = compare lab lab'
+
+cdssToOutput :: CDSSet -> [Output]
+cdssToOutput =  map cdsToOutput
+
+cdsToOutput (CDSNamed name cdsset)
+	    = OutLabel name res1 res2
+  where
+      res1 = [ cdss | (OutData cdss) <- res ]
+      res2 = [ out  | out@(OutLabel {}) <- res ]
+      res  = cdssToOutput cdsset
+cdsToOutput cons@(CDSCons {}) = OutData cons
+cdsToOutput    fn@(CDSFun {}) = OutData fn
+
+-- %************************************************************************
+-- %*									*
+-- \subsection{A Pretty Printer}
+-- %*									*
+-- %************************************************************************
+
+-- This pretty printer is based on Wadler's pretty printer.
+
+data DOC		= NIL			-- nil	  
+			| DOC :<> DOC		-- beside 
+			| NEST Int DOC
+			| TEXT String
+			| LINE			-- always "\n"
+			| SEP			-- " " or "\n"
+			| BREAK			-- ""  or "\n"
+			| DOC :<|> DOC		-- choose one
+			deriving (Eq,Show,Generic)
+data Doc		= Nil
+			| Text Int String Doc
+			| Line Int Int Doc
+			deriving (Show,Eq)
+
+
+mkText			:: String -> Doc -> Doc
+mkText s d		= Text (toplen d + length s) s d
+
+mkLine			:: Int -> Doc -> Doc
+mkLine i d		= Line (toplen d + i) i d
+
+toplen			:: Doc -> Int
+toplen Nil		= 0
+toplen (Text w s x)	= w
+toplen (Line w s x)	= 0
+
+nil			= NIL
+x <> y			= x :<> y
+nest i x		= NEST i x
+text s 			= TEXT s
+line			= LINE
+sep			= SEP
+brk			= BREAK
+
+fold x			= grp (brk <> x)
+
+grp 			:: DOC -> DOC
+grp x			= 
+	case flatten x of
+	  Just x' -> x' :<|> x
+	  Nothing -> x
+
+flatten 		:: DOC -> Maybe DOC
+flatten	NIL		= return NIL
+flatten (x :<> y)	= 
+	do x' <- flatten x
+	   y' <- flatten y
+	   return (x' :<> y')
+flatten (NEST i x)	= 
+	do x' <- flatten x
+	   return (NEST i x')
+flatten (TEXT s)	= return (TEXT s)
+flatten LINE		= Nothing		-- abort
+flatten SEP		= return (TEXT " ")	-- SEP is space
+flatten BREAK		= return NIL		-- BREAK is nil
+flatten (x :<|> y)	= flatten x
+
+layout 			:: Doc -> String
+layout Nil		= ""
+layout (Text _ s x)	= s ++ layout x
+layout (Line _ i x)	= '\n' : replicate i ' ' ++ layout x
+
+best w k doc = be w k [(0,doc)]
+
+be 			:: Int -> Int -> [(Int,DOC)] -> Doc
+be w k []		= Nil
+be w k ((i,NIL):z)	= be w k z
+be w k ((i,x :<> y):z)	= be w k ((i,x):(i,y):z)
+be w k ((i,NEST j x):z) = be w k ((k+j,x):z)
+be w k ((i,TEXT s):z)	= s `mkText` be w (k+length s) z
+be w k ((i,LINE):z)	= i `mkLine` be w i z
+be w k ((i,SEP):z)	= i `mkLine` be w i z
+be w k ((i,BREAK):z)	= i `mkLine` be w i z
+be w k ((i,x :<|> y):z) = better w k 
+				(be w k ((i,x):z))
+				(be w k ((i,y):z))
+
+better			:: Int -> Int -> Doc -> Doc -> Doc
+better w k x y		= if (w-k) >= toplen x then x else y
+
+pretty			:: Int -> DOC -> String
+pretty w x = observe "pretty" (\w' x'-> {-# SCC "pretty" #-} pretty' w' x') w x
+pretty' w x		= layout (best w 0 x)
+
+------------------------------------------------------------------------
+-- Stacks
+
+emptyStack = [""]
+type CallStack = [String]
+
+------------------------------------------------------------------------
+-- Events
+data Event = Event
+		{ portId     :: !Int
+		, parent     :: !Parent
+		, change     :: !Change
+		}
+	deriving (Show, Read)
+
+data Change
+	= Observe 	!String
+	| Cons    !Int 	!String
+	| Enter
+        | NoEnter
+	| Fun           !CallStack
+	deriving (Show, Read)
+
+data Parent = Parent
+	{ observeParent :: !Int	-- my parent
+	, observePort   :: !Int	-- my branch number
+	} deriving (Show, Read)
+root = Parent 0 0
diff --git a/examples/Responsibility.lhs b/examples/Responsibility.lhs
new file mode 100644
--- /dev/null
+++ b/examples/Responsibility.lhs
@@ -0,0 +1,32 @@
+> import Debug.Hoed
+
+sacc "outer" 1 + (sacc "inner" 2 * x)
+
+> ex1 :: Int -> Int
+> ex1 = (observe "outer") (\x -> {-# SCC "outer" #-} 
+>          1 + (((observe "inner") (\x -> {-# SCC "inner" #-} 2 * x)) x)
+>       )
+
+(sacc "com" \f g x -> f (g x)) (sacc "add" (+1)) (sacc "mul" (*2))
+
+> ex2 :: Int -> Int
+> ex2 = ((observe "com1") (\f g x -> {-# SCC "com1" #-} f (g x)))
+>       ((observe "add1") ({-# SCC "add1" #-} (+1)))
+>       ((observe "mul1") ({-# SCC "add1" #-} (*2)))
+
+> ex3 :: Int -> Int
+> ex3 = let f = ((observe "add2") ({-# SCC "add2" #-} (+1)))
+>           g = ((observe "mul2") ({-# SCC "add2" #-} (*2)))
+>       in  ((observe "com2") (\x -> {-# SCC "com2" #-} f (g x)))
+
+
+> ex4 :: Int -> Int
+> ex4 = let f = ((observe "f") ({-# SCC "f" #-} (+1)))
+>           g = ((observe "g") ({-# SCC "g" #-} (*2)))
+>       in  ((observe "h") ({-# SCC "h" #-} f . g))
+
+
+> main = runO $ do print (ex1 4)
+>                  print (ex2 4)
+>                  print (ex3 4)
+>                  print (ex4 4)
diff --git a/examples/Selectors.hs b/examples/Selectors.hs
deleted file mode 100644
--- a/examples/Selectors.hs
+++ /dev/null
@@ -1,10 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-import Debug.Hoed.Observe
-
-data Basket = FruitBasket { appels :: Int, pears :: Int } deriving (Generic)
-instance Observable Basket
-
-s FruitBasket {appels=a,pears=p} = a + p
-b = FruitBasket {appels=40,pears=2}
-
-main = (runO . putStrLn . show) (s $ gdmobserve "b" b)
diff --git a/examples/SternBrocot.lhs b/examples/SternBrocot.lhs
deleted file mode 100644
--- a/examples/SternBrocot.lhs
+++ /dev/null
@@ -1,92 +0,0 @@
-We need the Template Haskell extension to splice in the generated
-Observable instances. We need the Rank2Types extionsion to be able
-to specify parametrized types such as 'Tree a' with forall a.
-
-> {-# LANGUAGE TemplateHaskell, Rank2Types #-}
-
-We need the Derive Generic extention to derive the Generic representation
-used for the non spliced in observe (see the Cache data type).
-
-> {-# LANGUAGE DeriveGeneric #-}
-
-> import Debug.Hoed.Observe
-
-We use the Stern–Brocot tree as example. The Stern-Brocot tree is a
-binary tree containing all rational numbers. The tree is infinit and
-is therefore a nice example to demonstrate how laziness is handled.
-
-To store the tree we use the following datatype, note that because
-our definition is endless we do not actually use Leaf.
-
-> data Tree a = Node a (Tree a) (Tree a)
-
-The values in the tree will be fractional numbers:
-
-> data Frac = Frac Int Int deriving (Show,Generic)
-
-We use cache to store what the last seen up and to the left, and up and
-to the right values are.
-
-> data Cache = Cache { v :: Frac
->                    , l :: Frac
->                    , r :: Frac
->                    } deriving Generic
-
-Make Cache and Frac Observable for gdmobserve.
-
-> instance Observable Cache
-> instance Observable Frac
-
-The mediant is used to find which new number to insert between 2 exisiting
-numbers.
-
-> mediant :: Frac -> Frac -> Frac
-> mediant (Frac p1 q1) (Frac p2 q2) = Frac (p1+p2) (q1+q2)
-
-Definition of the sternbrocot tree:
-
-> sternbrocot :: Tree Frac
-> sternbrocot = sternbrocot' mediant
->
-> sternbrocot' :: (Frac -> Frac -> Frac) -> Tree Frac
-> sternbrocot' m = w_sternbrocot m Cache{v=(Frac 1 1), l=(Frac 0 1), r=(Frac 1 0)}
->
-> w_sternbrocot :: (Frac -> Frac -> Frac) -> Cache -> Tree Frac
-> w_sternbrocot m cache
->  = let Cache{v=v, l=l, r=r} = gdmobserve "cache" cache
->    in  Node v (w_sternbrocot m Cache{v=m v l, l=l, r=v})
->               (w_sternbrocot m Cache{v=m v r, l=v, r=r})
-
-The Stern-Brocot tree is sorted: all values in the left subtree are
-smaller than the value of the current node and all values in the right subtree
-are greater than the value in the current node.
-This can be used to approximate a Float value by doing a binary search where
-each next rational number is a better aproximation of the Float.
-
-> toFrac :: Float -> Tree Frac -> Frac
-> toFrac val (Node frac@(Frac p q) left right)
->  = case compare ((fromIntegral p) / (fromIntegral q)) val of
->       LT -> toFrac val right 
->       GT -> toFrac val left
->       EQ -> frac
-
-We use template-haskell to observe Tree and the values stored in Tree.
-
-> $(observedTypes "sternbrocot1" [ [t| forall a . Observable a => Tree a |]
->                                , [t| Frac |]
->                                ]
->  )
->
-> frac1 = toFrac 0.6 ($(observe "sternbrocot1") sternbrocot)
-
-Or to only observe which part of the tree is walked while ignoring
-the values stored in the tree.
-
-> $(observedTypes "sternbrocot2" [ [t| forall a . Tree a |]])
->
-> frac2 = toFrac 0.6 ($(observe "sternbrocot2") sternbrocot)
-
-Example main function:
-
-> main = runO $ do print frac1
->                  print frac2
diff --git a/examples/TH-hello.hs b/examples/TH-hello.hs
deleted file mode 100644
--- a/examples/TH-hello.hs
+++ /dev/null
@@ -1,16 +0,0 @@
-{-# LANGUAGE TemplateHaskell, Rank2Types #-}
-import Debug.Hoed.Observe
-
-data T = Hello | World
-
-f :: T -> T
-f Hello = World
-f World = Hello
-
-p :: T -> String
-p Hello = "Hello"
-p World = "world"
-
-$(observedTypes "f" [[t| T |]])
-main = runO . putStrLn $ (p . f') Hello
-  where f' = $(observe "f") f
diff --git a/examples/TightRope.hs b/examples/TightRope.hs
new file mode 100644
--- /dev/null
+++ b/examples/TightRope.hs
@@ -0,0 +1,30 @@
+-- This is an example from the "Learn You A Haskell" tuturial.
+-- The story is that there is a guy walking with a Pole where birds
+-- can land on the left and right. If the difference between birds
+-- on the left and right gets too big he falls off the rope. This
+-- is indicated by Nothing.
+
+import Debug.Hoed(runO,observe)
+
+type Birds = Int
+type Pole  = (Birds,Birds)
+
+landLeft :: Birds -> Pole -> Maybe Pole
+landLeft n p = observe "landLeft" (\n' p' -> {-# SCC "landLeft" #-} landLeft' n' p') n p
+landLeft' n (left,right)
+  | abs ((left + n) - right) < 4 = Just (left + n, right)
+  | otherwise                    = Nothing
+
+landRight :: Birds -> Pole -> Maybe Pole
+landRight n p = observe "landRight" (\n' p' -> {-# SCC "landRight" #-} landRight' n' p') n p
+landRight' n (left,right)
+  | abs (left - (right + n)) < 4 = Just (left, right + n)
+  | otherwise                    = Nothing
+        where x + y = x Prelude.+ (abs y)
+
+walk :: Maybe Pole
+walk = observe "walk" $ {-# SCC "walk" #-}
+        return (0,0) >>= landRight 1  >>= landLeft 1
+          >>= landRight 2 >>= landRight (-1) >>= landRight 1
+
+main = runO $ print walk
diff --git a/examples/TightRope2.hs b/examples/TightRope2.hs
new file mode 100644
--- /dev/null
+++ b/examples/TightRope2.hs
@@ -0,0 +1,53 @@
+-- This is an example from the "Learn You A Haskell" tuturial.
+-- The story is that there is a guy walking with a Pole where birds
+-- can land on the left and right. If the difference between birds
+-- on the left and right gets too big he falls off the rope. This
+-- is indicated by Nothing.
+
+import Debug.Hoed(runO,observe,observe',Identifier(..))
+
+type Birds = Int
+type Pole  = (Birds,Birds)
+
+landLeft :: Birds -> Identifier -> Pole -> (Maybe Pole, Int)
+landLeft n d p = let (f,i) = observe' "landLeft" d 
+                                (\n' p' -> {-# SCC "landLeft" #-} landLeft' n' p')
+                  in (f n p, i)
+landLeft' n (left,right)
+  | abs ((left + n) - right) < 4 = Just (left + n, right)
+  | otherwise                    = Nothing
+
+landRight :: Birds -> Identifier -> Pole -> (Maybe Pole, Int)
+landRight n d p = let (f,i) = observe' "landRight" d 
+                                 (\n' p' -> {-# SCC "landRight" #-} landRight' n' p')
+                   in (f n p, i)
+landRight' n (left,right)
+  | abs (left - (right + n)) < 4 = Just (left, right + n)
+  | otherwise                    = Nothing
+        where x + y = x Prelude.+ (abs y)
+
+walk :: Maybe Pole
+walk = observe "walk" $ {-# SCC "walk" #-}
+        return (0,0) *>>= landRight 1   >>== landLeft 1
+          >>== landRight 2 >>== landRight (-1) >>=* landRight 1
+
+main = runO $ print walk
+
+--------------------------------------------------------------------------------
+-- This used to be part of Observe, but implementing instance of TracedMonad
+-- for IO and State are challenging.
+
+class (Monad m) => TracedMonad m where
+  (*>>=) :: Monad m => m a               -> (Identifier -> a -> (m b, Int)) -> (m b, Identifier)
+  (>>==) :: Monad m => (m a, Identifier) -> (Identifier -> a -> (m b, Int)) -> (m b, Identifier)
+  (>>=*) :: Monad m => (m a, Identifier) -> (Identifier -> a -> (m b, Int)) -> m b
+
+instance TracedMonad Maybe where
+  (Just x)    *>>= f = let (y,i) = f UnknownId x in (y,InSequenceAfter i)
+  Nothing     *>>= f = (Nothing, UnknownId)
+
+  (Just x, d) >>== f = let (y,i) = f d x in (y,InSequenceAfter i)
+  (Nothing,_) >>== _ = (Nothing, UnknownId)
+
+  (Just x,d)  >>=* f = fst (f d x)
+  (Nothing,_) >>=* f = Nothing
diff --git a/examples/TightRope3.hs b/examples/TightRope3.hs
new file mode 100644
--- /dev/null
+++ b/examples/TightRope3.hs
@@ -0,0 +1,34 @@
+-- This is an example from the "Learn You A Haskell" tuturial.
+-- The story is that there is a guy walking with a Pole where birds
+-- can land on the left and right. If the difference between birds
+-- on the left and right gets too big he falls off the rope. This
+-- is indicated by Nothing.
+
+import Debug.Hoed(runO,observe,observe',Identifier(..),(*>>=),(>>==),(>>=*))
+
+type Birds = Int
+type Pole  = (Birds,Birds)
+
+landLeft :: Birds -> Identifier -> (Pole -> Maybe Pole, Int)
+landLeft n d
+  = let (f,i) = observe' "landLeft" d (\n' p' -> {-# SCC "landLeft" #-} landLeft' n' p')
+    in (f n, i)
+landLeft' n (left,right)
+  | abs ((left + n) - right) < 4 = Just (left + n, right)
+  | otherwise                    = Nothing
+
+landRight :: Birds -> Identifier -> (Pole -> Maybe Pole, Int)
+landRight n d 
+  = let (f,i) = observe' "landRight" d (\n' p' -> {-# SCC "landRight" #-} landRight' n' p')
+    in  (f n, i)
+landRight' n (left,right)
+  | abs (left - (right + n)) < 4 = Just (left, right + n)
+  | otherwise                    = Nothing
+        where x + y = x Prelude.+ (abs y)
+
+walk :: Maybe Pole
+walk = observe "walk" $ {-# SCC "walk" #-}
+        return (0,0) *>>= landRight 1   >>== landLeft 1
+          >>== landRight 2 >>== landRight (-1) >>=* landRight 1
+
+main = runO $ print walk
diff --git a/tests/DoublingServer.hs b/tests/DoublingServer.hs
new file mode 100644
--- /dev/null
+++ b/tests/DoublingServer.hs
@@ -0,0 +1,76 @@
+-- Based on the TrivialServer-example from Marlow, Parallel and Concurrent
+-- Programming in Haskell
+
+{-# LANGUAGE StandaloneDeriving #-}
+
+import System.IO
+import Network
+import Text.Printf
+import Control.Monad
+import Control.Concurrent
+import Debug.Hoed(observe,Observable(..),logO,send)
+import System.IO.Unsafe
+import Data.List
+
+twotimes :: Integer -> Integer
+twotimes j = (observe "twotimes"
+             ( \i -> {-# SCC "twotimes" #-} 
+                2 + i -- bug: should be 2 * i
+             )) j
+
+double :: String -> String
+double = observe "double" 
+         $ \s -> {-# SCC "double" #-} show (twotimes (read s :: Integer))
+
+loop h = do
+  line <- hGetLine h
+  if line == "end"
+     then do hPutStrLn h ("Thank you for using the Haskell doubling service.")
+             putStrLn $ "server: Terminated client " ++ show h
+     else do hPutStrLn h (double line)
+             loop h
+
+talk :: Handle -> IO ()
+talk h = do 
+  hSetBuffering h LineBuffering
+  i <- myThreadId
+  hPutStrLn h $ "Welcome on thread " ++ show i
+  loop h
+
+port :: Int
+port = 44444
+
+server :: Int -> Socket -> IO ()
+server = observe "server" (\x sock -> {-# SCC "server" #-} server' x sock)
+  where server' 0 _ = putStrLn "server: Shutting down."
+        server' x sock = do
+          (handle, host, port) <- accept sock
+          printf "server: Accepted connection from %s: %s\n" host (show port)
+          forkFinally (talk handle) (\_ -> hClose handle)
+          server (x-1) sock
+
+client :: Int -> IO ()
+client x = do
+  h <- connectTo "localhost" (PortNumber (fromIntegral port))
+  hSetBuffering h LineBuffering
+  let pr s = putStrLn $ "client-" ++ show x ++ ": " ++ s
+  
+  s <- hGetLine h; pr s -- Get and print the welcome message
+  hPutStrLn h (show x)  -- Send x for doubling to the server
+  s <- hGetLine h; pr s -- Get and print response from server
+  hPutStrLn h "end"     -- Send goodbye message
+  s <- hGetLine h; pr s -- Get and print response from server
+
+main :: IO ()
+main = logO "hoed-tests-DoublingServer.graph" $ withSocketsDo $ do
+  sock <- listenOn (PortNumber (fromIntegral port))
+  printf "server: Listening on port %d.\n" port
+  forkIO (server 2 sock) -- Start server in own thread.
+  client 2               -- Connect with two clients from this thread to the server.
+  client 3
+  threadDelay 1000       -- Give server-thread some time to terminate.
+
+slices = []
+
+instance Observable Handle where observer h = send (show h) (return h)
+instance Observable Socket where observer s = send "socket" (return s)
diff --git a/tests/Example1.hs b/tests/Example1.hs
new file mode 100644
--- /dev/null
+++ b/tests/Example1.hs
@@ -0,0 +1,9 @@
+import Debug.Hoed
+
+f :: Int -> Int
+f = observe "f" $ \x -> {-# SCC "f" #-} if x > 0 then g x else 0
+
+g :: Int -> Int
+g = observe "g" $ \x -> {-# SCC "g" #-} x `div` 2
+
+main = logO "hoed-tests-Example1.graph" $ print ((f 2) + (f 0))
diff --git a/tests/Example3.lhs b/tests/Example3.lhs
new file mode 100644
--- /dev/null
+++ b/tests/Example3.lhs
@@ -0,0 +1,27 @@
+> {-# LANGUAGE TemplateHaskell, Rank2Types #-}
+> import Debug.Hoed
+
+> $(observedTypes "k" [])
+> $(observedTypes "l" [])
+> $(observedTypes "m" [])
+> $(observedTypes "n" [])
+
+
+> main = logO "hoed-tests-Example3.graph" $ print (k 1)
+
+> k :: Int -> Int
+> k  x = $(observeTempl "k") k' x
+> k' x = {-# SCC "k" #-} k'' x
+> k'' x = (l x) + (m $ x + 1)
+
+> l :: Int -> Int
+> l  x  = $(observeTempl "l") l' x
+> l' x  = {-# SCC "l" #-} m x
+
+> m :: Int -> Int
+> m  x = $(observeTempl "m") m' x
+> m' x = {-# SCC "m" #-} n x
+
+> n :: Int -> Int
+> n  x = $(observeTempl "n") n' x
+> n' x = {-# SCC "n" #-} x
diff --git a/tests/Example4.hs b/tests/Example4.hs
new file mode 100644
--- /dev/null
+++ b/tests/Example4.hs
@@ -0,0 +1,3 @@
+import Debug.Hoed
+
+main = logO "hoed-tests-Example4.graph" $ print (observe "main" $ 42 :: Int)
diff --git a/tests/IndirectRecursion.lhs b/tests/IndirectRecursion.lhs
new file mode 100644
--- /dev/null
+++ b/tests/IndirectRecursion.lhs
@@ -0,0 +1,37 @@
+This is an example of how information is lost as a result of trunction of the
+cost centre stack. The actual call graph is of this program is:
+
+        main -> f 1 -> g 2 -> f 3 -> h 1
+
+But with pushing "f" a second time the "g" label is also lost. Additionally
+the h-statement is associated with the stack [f], which can either be from the
+untruncated f statement or the truncated f statement. We therefore infer the
+following call graph:
+
+        main -> f 1 -> {f 3, g 2} -> h 1
+                   \_________________^
+
+> {-# LANGUAGE TemplateHaskell, Rank2Types #-}
+> import Debug.Hoed
+
+> $(observedTypes "f" [])
+> $(observedTypes "g" [])
+> $(observedTypes "h" [])
+
+> f :: Int -> Int
+> f   x = $(observeTempl "f") f' x
+> f'  x = {-# SCC "f" #-} f'' x
+> f'' 1 = g 2
+> f'' x = h (x + 1)
+
+> g :: Int -> Int
+> g   x = $(observeTempl "g") g' x
+> g'  x = {-# SCC "g" #-} g'' x
+> g'' x = f (x + 1)
+
+> h :: Int -> Int
+> h   x = $(observeTempl "h") h' x
+> h'  x = {-# SCC "h" #-} h'' x
+> h'' x = (x+1)
+
+> main = logO "hoed-tests-IndirectRecursion.graph" $ print (f 1)
diff --git a/tests/Insort2.hs b/tests/Insort2.hs
new file mode 100644
--- /dev/null
+++ b/tests/Insort2.hs
@@ -0,0 +1,39 @@
+-- Haskell version of the buggy insertion sort as shown in Lee Naish
+-- A Declarative Debugging Scheme.
+--
+-- As Insort1, but with observe rather than templated observers.
+
+{-# LANGUAGE StandaloneDeriving #-}
+import Debug.Hoed
+
+-- Insertion sort.
+
+isort :: [Int] -> [Int]
+isort ns = observe "isort" (\ns -> {-# SCC "isort" #-} isort' ns) ns
+isort' []     = []
+isort' (n:ns) = insert n (isort ns)
+
+-- Insert number into sorted list.
+
+insert :: Int -> [Int] -> [Int]
+insert n ms = (observe "insert" (\n ms -> {-# SCC "insert" #-} insert' n ms)) n ms
+insert' :: Int -> [Int] -> [Int]
+insert' n []      = [n]
+insert' n (m:ms)
+      | n <= m    = n : ms -- bug: `m' is missing in this case
+      | otherwise = m : (insert n ms)
+
+main = logO "hoed-tests-Insort2.graph" . print $
+         (observe "result") ({-# SCC "result" #-} isort [1,2])
+
+-- Slices, these should be generated automatically from the original code.
+
+slices
+  = [ ("result",  "isort [1,2]")
+    , ("isort" ,  "isort []     = []\n"
+               ++ "isort (n:ns) = insert n (isort ns)")
+    , ("insert",  " insert n []       = [n]\n"
+               ++ " insert n (m:ms)\n"
+               ++ "       | n <= m    = n : ms\n"
+               ++ "       | otherwise = m : (insert n ms)\n")
+    ]