{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-}
-- |The "Traced" module provides a simple way of tracing expression evaluation.
-- A value of type @Traced a@ has both a value of type @a@ and an expression tree
-- that describes how the value was computed.
--
-- There are instances for the 'Traced' type for all numeric classes to make
-- it simple to trace numeric expressions.
--
-- The expression tree associated with a traced value is exactly that: a tree.
-- But evaluation of expressions in Haskell typically has sharing to avoid recomputation.
-- This sharing can be recovered by the (impure) 'reShare' function.
--
-- $examples
module Debug.Traced(
Traced, traced, named, nameTraced, unknown, unTraced, tracedD,
TracedD, unTracedD,
Traceable,
liftT, liftFun, Liftable,
showAsExp, showAsExpFull,
reShare, simplify,
ifT, (%==), (%/=), (%<), (%<=), (%>), (%>=),
(%&&), (%||), tnot,
TracedExp, tracedExp, namedExp
) where
import Data.Typeable(Typeable)
import Debug.TracedInternal
-- Boolean operations
-- |Traced version of /if/.
ifT :: (Traceable a) => Traced Bool -> Traced a -> Traced a -> Traced a
ifT c t e = apply (unTraced $ if b then t else e) "ifT" Nonfix $ tracedD c : if b then [tracedD t, none] else [none, tracedD e]
where none = tracedD u
u = unknown "..." `asTypeOf` t
b = unTraced c
infix 4 %==, %/=, %<, %<=, %>, %>=
-- |Comparisons generating traced booleans.
(%==), (%/=) :: (Traceable a, Eq a) => Traced a -> Traced a -> Traced Bool
(%==) = binOp (==) ("==", Infix 4)
(%/=) = binOp (/=) ("/=", Infix 4)
(%<), (%<=), (%>), (%>=) :: (Traceable a, Ord a) => Traced a -> Traced a -> Traced Bool
(%<) = binOp (<) ("<", Infix 4)
(%<=) = binOp (<=) ("<=", Infix 4)
(%>) = binOp (>) (">", Infix 4)
(%>=) = binOp (>=) (">=", Infix 4)
infixr 3 %&&
infixr 2 %||
(%&&) :: Traced Bool -> Traced Bool -> Traced Bool
(%&&) = binOp (&&) ("&&", InfixR 3)
(%||) :: Traced Bool -> Traced Bool -> Traced Bool
(%||) = binOp (&&) ("||", InfixR 2)
tnot :: Traced Bool -> Traced Bool
tnot = unOp not "not"
-----------------------------------
-- |A wrapper for 'Traced' to show it with full details.
newtype TracedExp a = TracedExp (Traced a)
deriving (Typeable, Eq, Ord, Num, Fractional, Integral, Enum, Real, RealFrac, Floating, RealFloat)
instance (Traceable a, Show a) => Show (TracedExp a) where
show (TracedExp x) = showAsExpFull x
tracedExp :: (Traceable a) => a -> TracedExp a
tracedExp = TracedExp . traced
namedExp :: (Traceable a) => String -> a -> TracedExp a
namedExp s = TracedExp . named s