traced-2008.7.4: Simple evaluation trace

Debug.Traced

Description

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

Synopsis

Documentation

data Traced t a Source

Traced values of some type.

Instances

Typeable2 Traced 
Liftable Bool (Traced t Bool) 
Liftable Double (Traced t Double) 
Liftable Float (Traced t Float) 
Liftable Int (Traced t Int) 
Liftable Integer (Traced t Integer) 
Liftable Ordering (Traced t Ordering) 
Liftable () (Traced t ()) 
(Show a, Typeable a, Enum a) => Enum (Traced t a) 
Eq a => Eq (Traced t a) 
(Num t, Typeable a, Floating a) => Floating (Traced t a) 
(Num t, Typeable a, Fractional a) => Fractional (Traced t a) 
(Num t, Typeable a, Integral a) => Integral (Traced t a) 
(Num t, Typeable a, Num a) => Num (Traced t a) 
Ord a => Ord (Traced t a) 
(Num t, Typeable a, Real a) => Real (Traced t a) 
(Num t, Typeable a, RealFloat a) => RealFloat (Traced t a) 
(Num t, Typeable a, RealFrac a) => RealFrac (Traced t a) 
(Num t, Show a) => Show (Traced t a) 
(Typeable a, Show a, Liftable b tb) => Liftable (a -> b) (Traced t a -> tb) 

traced :: (Show a, Typeable a) => a -> Traced t aSource

Create a traced value.

named :: (Show a, Typeable a) => String -> a -> Traced t aSource

Create a named traced value.

nameTraced :: String -> Traced t a -> Traced t aSource

Add a named to a traced value.

unknown :: (Show a, Typeable a) => String -> Traced t aSource

Create a named thing with no value. Cannot be used where a real value is needed.

unTraced :: Traced t a -> aSource

Extract the real value from a traced value.

tracedD :: Traced t a -> TracedDSource

Extract the expression tree from a traced value.

data TracedD Source

Expression tree for a traced value.

Constructors

NoValue

unknown value

forall a . Name Bool Name TracedD

value with a name

forall a . (Show a, Typeable a) => Con a

constant

forall a . (Show a, Typeable a) => Apply a Name Fixity [TracedD]

application

forall a . Let [(Name, TracedD)] TracedD

(recovered) let expression

unTracedD :: Typeable a => TracedD -> Maybe (Traced t a)Source

Convert an expression tree to a traced value, if the types are correct.

liftT :: Liftable a b => Name -> Fixity -> a -> bSource

liftFun :: Liftable a b => Name -> a -> bSource

ifT :: (Show a, Typeable a) => Traced t Bool -> Traced t a -> Traced t a -> Traced t aSource

Traced version of if.

(%==) :: Eq a => Traced t a -> Traced t a -> Traced t BoolSource

(%/=) :: Eq a => Traced t a -> Traced t a -> Traced t BoolSource

Comparisons generating traced booleans.

(%<) :: Ord a => Traced t a -> Traced t a -> Traced t BoolSource

(%<=) :: Ord a => Traced t a -> Traced t a -> Traced t BoolSource

(%>) :: Ord a => Traced t a -> Traced t a -> Traced t BoolSource

(%>=) :: Ord a => Traced t a -> Traced t a -> Traced t BoolSource

data Fixity Source

Fixity for identifier.

Constructors

InfixL Int 
InfixR Int 
Infix Int 
Nonfix 

showAsExp :: Show a => Traced t a -> StringSource

Show the expression tree of a traced value.

showAsExpFull :: Show a => Traced t a -> StringSource

Show the expression tree of a traced value, also show the value of each variable.

reShare :: Typeable a => Traced t a -> Traced t aSource

simplify :: Traced t a -> Traced t aSource

Simplify an expression tree.

data AsExp Source

Instances