module Observe where

import Data.IORef
import System.IO.Unsafe
import List (intersperse,nub)
import Control.Exception(catch)
import Prelude hiding (catch)

data EvalTree = Cons String [EvalTreeRef] 
	      | Fun [(EvalTreeRef,EvalTreeRef)]
	      | Uneval 
	      | Demand

type EvalTreeRef = IORef EvalTree

showEvalTree :: EvalTree -> IO String
showEvalTree t = showsEvalTree t >>= return . ($"")

showsEvalTreeRef :: EvalTreeRef -> IO ShowS
showsEvalTreeRef r = do
  val <- readIORef r
  xs <- showsEvalTree val
  return xs

showsEvalTree :: EvalTree -> IO ShowS
showsEvalTree Uneval = return ("_"++)
showsEvalTree Demand = return ("!"++)
showsEvalTree (Cons  cons []) = return (cons++)
showsEvalTree (Cons "(,)" ts) = do
  [aa,ab] <- mapM showsEvalTreeRef ts
  return (("("++).aa.(","++).ab.(")"++))
showsEvalTree (Cons "(,,)" ts) = do
  [aa,ab,ac] <- mapM showsEvalTreeRef ts
  return (("("++).aa.(","++).ab.(","++).ac.(")"++))
showsEvalTree (Cons "(:)" ts) = do
  [aa,ab] <- mapM showsEvalTreeRef ts
  return (("("++).aa.(":"++).ab.(")"++))
showsEvalTree (Cons cons ts) = do
  args <- mapM showsEvalTreeRef ts
  return (("("++).foldr (.) (")"++) (intersperse (" "++) ((cons++):args)))
showsEvalTree (Fun appls) = do
  resStrs <- mapM showsApp (reverse appls)
  return (foldr (.) id (intersperse ("\n"++) resStrs))
 where showsApp (rArg,rRes) = do
         arg <- showsEvalTreeRef rArg
         res <- showsEvalTreeRef rRes
	 return (("{"++).arg.(" -> "++).res.("}"++))