MIXING TRACED AND UNTRACED COMPUTATION
ART Memo 22 (Version 0)
Colin Runciman, 17 July 2001


INTRODUCTION

The current version of Hat (1.06) requires all modules to be compiled
under -T, even those that are trusted.  It would be better if trusted
parts of a program could be compiled normally, without tracing
machinery, for several reasons:

* shorter compile-time and less object code;

* shorter run-time and less trace data;

* easier to port Hat to a different compiler --- no need to mangle the
  sources of compiler-specific preludes and libraries.

However, values inhabit different types in the traced and untraced
worlds.  Components compiled normally can only work in combination
with components compiled for tracing if there is some interface that
translates between types.  This interface could, for example, provide
a collection of `wrappers' that define trace-compatible versions of
functions as applications of their untraced counterparts with translated
arguments and results.

This memo describes a wrapping solution in the context of a simplified
scheme of traced computation.  Although the scheme is a simplification it
does reflect at least two important aspects of the actual tracing scheme:

* a pervasive change of representation types;

* the introduction of combinators for abstraction and application.

My intention is that a subsequent version of the memo will extended
wrapping to a tracing framework closer to the Hat reality.


THE T SCHEME

In a simplified version of traced values every value (at every level,
in the case of composite types) is tagged with a constructor T.

data T a = T a

unT (T x) = x

All types are transformed by the wrapping transformation W, defined
as follows, where p indicates a primitive type, v a type variable,
t an arbitrary type, D a data constructor and C a type constructor.

                       W p => T p
                       W v => v
W (... | D t1 .. tn | ...) => ... | DT (W t1) .. (W tn) | ...
            W (C t1 .. tn) => T (CT (W t1) .. (W tn))
              W (t1 -> t2) => T ((W t1) -> (W t2))

So, for example, the T-scheme representation of lists can be
derived as follows:

data LisT a = W (Nil | Cons a (List a)
            = NilT | ConsT (W a) (W (List a))
	    = NilT | ConsT a (T (LisT (W a)))
	    = NilT | ConsT a (T (LisT a))

The T-scheme type-signature for `foldr' is

foldrT :: T (T (a -> T (b -> b)) -> T (b -> T (T (LisT a) -> b)))

As in the full Hat transformation, to define and apply T-scheme
functions it is convenient to introduce a family of abstraction
and application combinators for each possible arity.

abstr1 :: (a -> b) -> T (a -> b)
abstr1 = T

apply1 :: T (a -> b) -> a -> b
apply1 = unT

abstr2 :: (a -> b -> c) -> T (a -> T (b -> c))
abstr2 f = T (\x -> abstr1 (f x))

apply2 :: T (a -> T (b -> c)) -> a -> b -> c
apply2 (T f) = \x -> apply1 (f x)

and this generalises for any N>1 to

abstr<N> f = T (\x -> abstr<N-1> (f x))

apply<N> (T f) = \x -> apply<N-1> (f x)

Here, for example, is a definition of foldrT:

foldrT = abstr3 foldrT'
foldrT' f z (T NilT) = z
foldrT' f z (T (ConsT x xs)) = apply2 f x (apply3 foldrT f z xs)

The Hat transformation introduces definitions in a similar style,
but with extra structure for trace values.


TESTING THE TWIZZLER

As a test example, I wrote a T-version of the Twizzle program and
T-versions of most of the Prelude functions Twizzle needs -- see Appendix.
Most of the definitions are in much the same style as the above definition
of foldrT.  I was too lazy to make T-versions of things like show
and putStr.


This T-version of Twizzle is about 2.5 times slower than the original.


RULES FOR WRAPPING

Instead of transforming all the defining equations from their original
definitions, how can T-versions of functions be defined instead by
wrapped applications of their originals?  Intuitively, the main job for
the wrapper is translating the representation types of arguments and result.

For values of a primitive type the translation functions are just T and unT.

For values of an algebraic datatype the translation functions must
traverse a data structure constructed in one representation type,
reconstructing it in the other.  If the datatype is polymorphic the
translation must also be parametrised by translation functions for the
polymorphic components.  For example, functions fromLisT and toLisT can
be defined like this:

toLisT :: (a -> b) -> [a] -> T (LisT b)
toLisT f [] = T NilT
toLisT f (x:xs) = T (ConsT (f x) (toLisT f xs))

fromLisT :: (b -> a) -> T (LisT b) -> [a]
fromLisT g (T NilT) = []
fromLisT g (T (ConsT y ys)) = g y : fromLisT g ys

Functional values can almost be translated just by composing them with
argument and result translations.  But translations to the T-scheme must
also introduce an abstraction combination, and translations from it need an
apply combination.

Finally, but very importantly, wrapped polymorphic functions should
still be polymorphic.  Since polymorphic type variables range over
all types, their instances include both traced and untraced representations
alike.  A polymorphic length function, for example, cares nothing about
the wrapped or unwrapped representation of the list elements. So the
translation functions for unconstrained polymorphic types can be just
the identity. There is no need for translations to re-encode values down
to the level of their most primitive components.

Putting these observations together, given the type signature of a normal
(untracing) function f, the definition of its wrapped counterpart fT can
be derived using the following WR rule.  As before, p indicates a
primitive type, v a type variable, and t an arbitrary type.

            WR (f :: t) =>  fT = WT t f

                   WT b => T
                   WT v => id
                 WT [t] => toLisT (WT t)
WT (t1 ->..-> tn -> tr) => \f -> abstrn (\a1..an ->
                             (WT tr) (f (WF t1 a1)..(WF tn an)))

                   WF b => unT
                   WF v => id
                 WF [t] => fromLisT (WF t)
WF (t1 ->..-> tn -> tr) => \f a1..an ->
                             (WF tr) (applyn f (WT t1 a1)..(WT tn an))

For example, here is the derivation for foldrT (with a little alpha
renaming to help the reader):

   WR (foldr :: (a -> b -> b) -> b -> [a] -> b

=> foldrT = WT ((a -> b -> b) -> b -> [a] -> b) foldr

=> foldrT = (\f -> abstr3 (\a1 a2 a3 ->
              (WT b) (f (WF (a->b->b) a1) (WF b a2) (WF [a] a3)))) foldr

=> foldrT = (\f -> abstr3 (\a1 a2 a3 ->
              id (f ((\g x1 x2 -> (WF b) (apply2 g (WT a x1) (WT b x2))) a1)
	            (id a2)
		    (fromLisT id a3) ))) foldr

=> foldrT = (\f -> abstr3 (\a1 a2 a3 ->
              id (f ((\g x1 x2 -> id (apply2 g (id x1) (id x2))) a1)
	            (id a2)
		    (fromLisT id a3) ))) foldr

Phew! Such definitions can helpfully be simplified by beta-reduction
and the reduction of id applications.  Also, as polymorphic lists are
common, id can be expected to occur frequently as the argument to toList
or fromList, and it is worth defining toPolyList and fromPolyList for
these special cases.

toPolyLisT :: [a] -> T (LisT a)
toPolyLisT [] = T NilT
toPolyLisT (x:xs) = T (ConsT x (toPolyLisT xs))

fromPolyLisT :: T (LisT a) -> [a]
fromPolyLisT (T NilT) = []
fromPolyLisT (T (ConsT y ys)) = y : fromPolyLisT ys

For example, after simplification the definition of foldrT becomes (with
the conventional renaming of a1 to f, a2 to z and a3 to xs):

foldrT = abstr3 (\f z xs -> foldr (apply2 f) z (fromPolyLisT xs))


BACK TO THE TWIZZLER

So what happens if the mini-prelude defined for the Twizzle program
is revised to use wrappers calling the untraced Prelude?  It works,
but execution is now about a factor of 3 slower than for the original
untraced program.  The cost of wrapping is higher than the cost of fully
transformed Prelude functions.  Why should this be?


NEEDED BUT UNEVALUATED STRUCTURES

The reason has to do with functions such as appendT:

appendT :: T (T (LisT a) -> T (T (LisT a) -> T (LisT a)))
appendT = abstr2 (\xs ys ->
            toPolyList (fromPolyList xs ++ fromPolyList ys))

An untraced application append xs ys never needs to evaluate the list ys.
This list only has to be used to replace nil at the end of a reconstructed
xs and "CONS does not evaluate its arguments".  In contrast, the function
appendT potentially converts the whole of ys into a normal list, only
to convert it all back again as part of the result!  When a large list is
built using a chain of right-associative appends (as it is in the Twizzle
program) this redundant translation and re-translation in appendT is a
serious overhead.

The problem is not laziness.  Laziness is preserved, and the extra
translations are only performed so far as the resulting list is needed.

More generally, similar problems of unnecessary overheads may be incurred
for any function that incorporates an argument of recursive type, or a
recursive component of such an argument, into its result.  Other examples
over lists include functions such as `tail' or `drop'.

At the time of writing I have no simple solution to this problem.  An ad hoc
solution for the Prelude is to revert to a transformed function instead
of a wrapper for functions that pose this problem.  In the Twizzler program,
using a transformed append but wrappers for all other Prelude functions
reduces the slow-down factor to about 2.

The problem may be less significant in the context of a full tracing scheme,
where wrapping avoids greater costs of a more complex transformation.


CLASSES AND MONADS

I haven't thought much about these, but I don't see why they should
cause any major problems.


APPENDIX 1 -- THE PLAIN TWIZZLE PROGRAM

main = putStr (allTwizzles 6)

allTwizzles :: Int -> String
allTwizzles k = unlines (map twizzle (perms [1..k]))

twizzle :: [Int] -> String
twizzle s = derivation (iterate twiz s)

derivation :: [[Int]] -> String
derivation (s:ss) =
  show s ++
  (if head s == 1 then "" else " => " ++ derivation ss)

twiz :: [Int] -> [Int]
twiz s =
  reverse (take n s) ++ drop n s
  where
  n = head s

perms :: [a] -> [[a]]
perms [] = [[]]
perms (x:xs) = concatMap (insertions x) (perms xs)

insertions :: a -> [a] -> [[a]]
insertions x [] = [[x]]
insertions x (y:ys) = (x:y:ys) : map (y:) (insertions x ys)


APPENDIX 2 -- T-SCHEME VERSION OF TWIZZLER

main = putStr (unwrapString (apply1 allTwizzlesT (T 6)))

allTwizzlesT :: T (T Int -> T (LisT (T Char)))
allTwizzlesT = abstr1 allTwizzlesT'
allTwizzlesT' k =
  apply1 unlinesT
    (apply2 mapT twizzleT
      (apply1 permsT (toLisT T [1 .. unT k])) )

twizzleT :: T (T (LisT (T Int)) -> T (LisT (T Char)))
twizzleT = abstr1 twizzleT'
twizzleT' s = apply1 derivationT (apply2 iterateT twizT s)

derivationT :: T (T (LisT (T (LisT (T Int)))) -> T (LisT (T Char)))
derivationT = abstr1 derivationT'
derivationT' (T (ConsT s ss)) =
  apply2 appendT
    (wrapString (show (fromLisT unT s)))
    (if (apply1 headT s) == (T 1)
      then wrapString ""
      else apply2 appendT (wrapString " => ") (apply1 derivationT ss))

twizT :: T (T (LisT (T Int)) -> T (LisT (T Int)))
twizT = abstr1 twizT'
twizT' s =
  apply2 appendT
    (apply1 reverseT (apply2 takeT n s))
    (apply2 dropT n s)
  where
  n = apply1 headT s

permsT :: T (T (LisT a) -> T (LisT (T (LisT a))))
permsT = abstr1 permsT'
permsT' (T NilT) = T (ConsT (T NilT) (T NilT))
permsT' (T (ConsT x xs)) =
  apply2 concatMapT (apply1 insertionsT x) (apply1 permsT xs)

insertionsT :: T (a -> T (T (LisT a) -> T (LisT (T (LisT a)))))
insertionsT = abstr2 insertionsT'
insertionsT' x (T NilT) = T (ConsT (T (ConsT x (T NilT))) (T NilT))
insertionsT' x (T (ConsT y ys)) =
  T (ConsT
    (T (ConsT x (T (ConsT y ys))))
    (apply2 mapT (apply1 (funCon2 ConsT) y) (apply2 insertionsT x ys)) )
    

APPENDIX 3 -- TRACED MINI-PRELUDE

appendT :: T (T (LisT a) -> T (T (LisT a) -> T (LisT a)))
appendT  = abstr2 appendT'
appendT' (T NilT) ys = ys
appendT' (T (ConsT x xs)) ys = T (ConsT x (apply2 appendT xs ys))

headT :: T (T (LisT a) -> a)
headT = abstr1 headT'
headT' (T (ConsT x _)) = x

takeT :: T (T Int -> T (T (LisT a) -> T (LisT a)))
takeT = abstr2 takeT'
takeT' (T n) (T (ConsT x xs)) | n > 0 = T (ConsT x (apply2 takeT (T (n-1)) xs))
takeT' _ _ = T NilT

dropT :: T (T Int -> T (T (LisT a) -> T (LisT a)))
dropT = abstr2 dropT'
dropT' (T n) (T (ConsT x xs)) | n > 0 = apply2 dropT (T (n-1)) xs
dropT' _ xs = xs

mapT :: T (T (a -> b) -> T (T (LisT a) -> T (LisT b)))
mapT = abstr2 mapT'
mapT' _ (T NilT) = T NilT
mapT' f (T (ConsT x xs)) = T (ConsT (apply1 f x) (apply2 mapT f xs))

foldrT :: T (T (a -> T (b -> b)) -> (T (b -> T (T (LisT a) -> b))))
foldrT = abstr3 foldrT'
foldrT' f z (T NilT) = z
foldrT' f z (T (ConsT x xs)) = apply2 f x (apply3 foldrT f z xs)

concatT :: T (T (LisT (T (LisT a))) -> T (LisT a))
concatT = apply2 foldrT appendT (T NilT)

foldlT :: T (T (a -> T (b -> a)) -> (T (a -> T (T (LisT b) -> a))))
foldlT = abstr3 foldlT'
foldlT' f z (T NilT) = z
foldlT' f z (T (ConsT x xs)) = apply3 foldlT f (apply2 f z x) xs

reverseT :: T (T (LisT a) -> T (LisT a))
reverseT = apply2 foldlT (apply1 flipT (funCon2 ConsT)) (T NilT)

flipT :: T (T (a -> T (b -> c)) -> T (b -> T (a -> c)))
flipT = abstr3 flipT'
flipT' f x y = apply2 f y x

concatMapT :: T (T (a -> T (LisT b)) -> T (T (LisT a) -> T (LisT b)))
concatMapT = abstr2 concatMapT'
concatMapT' f xs = apply1 concatT (apply2 mapT f xs)

iterateT :: T (T (a -> a) -> T (a -> (T (LisT a))))
iterateT = abstr2 iterateT'
iterateT' f x = T (ConsT x (apply2 iterateT f (apply1 f x)))

unlinesT :: T (T (LisT (T (LisT (T Char)))) -> T (LisT (T Char)))
unlinesT = abstr1 unlinesT'
unlinesT' xs =
  apply1 concatT (apply2 mapT (apply2 flipT appendT (wrapString "\n")) xs)
  

APPENDIX 4 -- WRAPPED MINI-PRELUDE

appendT :: T (T (LisT a) -> T (T (LisT a) -> T (LisT a)))
appendT  = abstr2 (\xs ys -> toPolyLisT (fromPolyLisT xs ++ fromPolyList ys))

headT :: T (T (LisT a) -> a)
headT = abstr1 (\xs -> head (fromPolyLisT xs))

takeT :: T (T Int -> T (T (LisT a) -> T (LisT a)))
takeT = abstr2 (\n xs -> toPolyLisT (take (unT n) (fromPolyLisT xs)))

dropT :: T (T Int -> T (T (LisT a) -> T (LisT a)))
dropT = abstr2 (\n xs -> toPolyLisT (drop (unT n) (fromPolyLisT xs)))

mapT :: T (T (a -> b) -> T (T (LisT a) -> T (LisT b)))
mapT = abstr2 (\f xs -> toPolyLisT (map (apply1 f) (fromPolyLisT xs)))

foldrT :: T (T (a -> T (b -> b)) -> (T (b -> T (T (LisT a) -> b))))
foldrT = abstr3 (\f z xs -> foldr (apply2 f) z (fromPolyLisT xs))

concatT :: T (T (LisT (T (LisT a))) -> T (LisT a))
concatT = abstr1 (\xss -> toPolyLisT (concat (fromLisT (fromPolyLisT) xss)))

foldlT :: T (T (a -> T (b -> a)) -> (T (a -> T (T (LisT b) -> a))))
foldlT = abstr3 (\f z xs -> foldl (apply2 f) z (fromPolyLisT xs))

reverseT :: T (T (LisT a) -> T (LisT a))
reverseT = abstr1 (\xs -> toPolyLisT (reverse (fromPolyLisT xs)))

flipT :: T (T (a -> T (b -> c)) -> T (b -> T (a -> c)))
flipT = abstr3 (\f x y -> flip (apply2 f) x y)

concatMapT :: T (T (a -> T (LisT b)) -> T (T (LisT a) -> T (LisT b)))
concatMapT = abstr2 (\f xs ->
  toPolyLisT (concatMap (fromPolyLisT . apply1 f) (fromPolyLisT xs)))

iterateT :: T (T (a -> a) -> T (a -> (T (LisT a))))
iterateT = abstr2 (\f x -> toPolyLisT (iterate (apply1 f) x))

unlinesT :: T (T (LisT (T (LisT (T Char)))) -> T (LisT (T Char)))
unlinesT = abstr1 (\xs -> wrapString (unlines (fromLisT unwrapString xs)))