Part one of this series introduced the problem of memoizing functions involving polymorphic recursion. The caching data structures used in memoization typically handle only one type of argument at a time. For instance, one can have finite maps of differing types, but each concrete finite map holds just one type of key and one type of value.

I extended memoization to handle polymorphic recursion by using an existential type together with a reified type of types. This extension works (afaik), but it is restricted to a particular form for the type of the polymorphic function being memoized, namely

– Polymorphic function
type k :–> v = forall a. HasType a => k a -> v a

My motivating example is a GADT-based representation of typed lambda calculus, and some of the functions I want to memoize do not fit the pattern. After writing part one, I fooled around and found that I could transform these awkwardly typed polymorphic functions into isomorphic form that does indeed fit the restricted pattern of polymorphic types I can handle.

Awkward types

The first awkwardly typed memoizee is the function application constructor:

type AT = forall a b . (HasType a, HasType b) => E (a -> b) -> E a -> E b
 
(:^) :: AT

Right away AT misses the required form. It has two HasType constraints, and the first argument is parameterized over two type variables instead of one. However, the second argument looks more promising, so let’s flip the arguments to get an isomorphic type:

forall a b . (HasType a, HasType b) => E a -> E (a -> b) -> E b

And then move the quantifier and constraint on b inside the outer (first) ->:

forall a . HasType a => E a -> (forall b. HasType b => E (a -> b) -> E b)

We’re getting closer. Next, define a newtype wrapper.

newtype A2 a = A2 (forall b. HasType b => E (a -> b) -> E b)

So that AT is isomorphic to

forall a . HasType a => E a -> A2 a

i.e.,

E :–> A2

The function inside of A2 doesn’t have the required form, but another newtype wrapper finishes the job.

newtype EF a b = EF {unEF :: E (a -> b) }
 
type H’ a = EF a :–> E
 
newtype H a = H { unH :: H’ a }

The AT type is isomorphic AP where

type AP = E :–> H

Curried memoization

A “curried memo function” is one that takes one argument and produces another memo function. For a simple memo function, not involving polymorphic recursion, there’s a simple recipe for curried memoization:

memo2 :: (a -> b -> c) -> (a -> b -> c)
memo2 f = memo (memo . f)

Our more polymorphic memo makes currying a little more awkward. First, here’s a helper function for working inside of the representation of an H:

inH :: (H’ a -> H’ a) -> (H a -> H a)
inH h z = H (h (unH z))

The following more elegant definition don’t type-check, due to the rank 2 polymorphism:

inH f = H . f . unH  – type error

Now our AP memoizer is much like memo2:

memoAP :: AP -> AP
memoAP app‘ = memo (inH memo . app‘)

(A more general, consistent type for memoAP is (f :--> H) -> (f :--> H).)

Isomorphisms

Now, to define the isomorphisms. Define

toAP   :: AT -> AP
fromAP :: AP -> AT

The definitions:

toAP app ea = H $ \ (EF eab) -> app eab ea
fromAP app‘ eab ea = unH (app‘ ea) (EF eab)

If you erase the newtype wrappers & unwrappers, you’ll see that toAP and fromAP are both just flip.

I constructed fromAP from the following specification:

toAP (fromAP app‘) == app‘

Transforming step-by-step into equivalent specifications:

\ ea -> H $ \ (EF eab) -> (fromAP app‘) eab ea == app‘
 
H $ \ (EF eab) -> (fromAP app‘) eab ea == app‘ ea
 
\ (EF eab) -> (fromAP app‘) eab ea == unH (app‘ ea)
 
(fromAP app‘) eab ea == unH (app‘ ea) (EF eab)
 
fromAP app‘ eab ea == unH (app‘ ea) (EF eab)

Memoizing vis isomorphisms

Finally, I can memoize

memoAT :: AT -> AT
memoAT app = fromAP (memoAP (toAP app))

Again, a more elegant definition via (.) fails to type-check, due to rank 2 polymorphism.

The Lam (lambda abstraction) constructor can be handled similarly:

Lam  :: (HasType a, HasType b) => V a -> E b -> E (a -> b)

This time, no flip is needed.

I wonder

How far does this isomorphism trick go?

Is there an easier way to memoize polymorphic functions?

Memoization takes a function and gives back a semantically equivalent function that reuses rather than recomputes when applied to the same argument more than once. Variations include not-quite-equivalence due to added strictness, and replacing value equality with pointer equality.

Memoization is often packaged up polymorphically:

memo :: (???) => (k -> v) -> (k -> v)

For pointer-based (”lazy”) memoization, the type constraint (”???”) is empty. For equality-based memoization, we’d need at least Eq k, and probably Ord k or HasTrie k for efficient lookup (in a finite map or a possibly infinite memo trie).

Although memo is polymorphic, its argument is a monomorphic function. Implementations that use maps or tries exploit that monomorphism in that they use a type like Map k v or Trie k v. Each map or trie is built around a particular (monomorphic) type of keys. That is, a single map or trie does not mix keys of different types.

Now I find myself wanting to memoize polymorphic functions, and I don’t know how to do it.

Flavors of polymorphism

If a recursively defined function f is polymorphic, then the recursion may still be monomorphic. That is, recursive calls may be restricted to the same type instance as the parent call. Most recursive polymorphic functions fit this form, because most polymorphic recursive data types are “regular”, meaning that a polymorphic data type is included in itself only at the same type instance. For instance, the usual polymorphic lists and trees are regular.

Example: GADTs

Among other places, non-regular, or “nested data types” arise in statically typed encodings of typed languages. For instance, here’s a GADT (generalized algebraic data type) for typed lambda calculus expressions:

– Variables
data V a = V String (Type a)
 
– Expressions
data E :: * -> * where
  Lit  :: a -> E a                      – literal
  Var  :: V  a -> E a                   – variable
  (:^) :: E (a -> b) -> E a -> E b      – application
  Lam  :: V a -> E b -> E (a -> b)      – abstraction

The Type type is sort of like TypeRep, except that it is statically typed.

data Type :: * -> * where
  Bool   :: Type Bool
  Float  :: Type Float
  …
  (:*:)  :: Type a -> Type b -> Type (a,b)
  (:->:) :: Type a -> Type b -> Type (a->b)

These GADTs (E and Type) are both non-regular, and so recursive functions over them will involve more than one argument type.

So how can we memoize?

A first try

Let’s consider a specific case of polymorphic functions:

type k :–> v = ∀ a. HasType a => k a -> v a

HasType is to Typeable as Type is to TypeRep. The memo implementation I’m playing with relies on HasType.

The memoizer can have type

memo :: (k :–> v) -> (k :–> v)

which uses rank 2 polymorphism (because of the argument type’s ∀, which,, cannot be moved to the outside).

My implementation of memo is similar to the discussion in Stretching the storage manager: weak pointers and stable names in Haskell, but modernized a bit and adapted for polymorphism. It uses an IntMap of lists of pairs of stable names (akin to pointers) for arguments and values for results. The idea is to first use hashStableName to get an Int to use as an IntMap key, and then linearly traverse the resulting list of binding pairs, comparing stable keys for equality. (StableName has Eq but not Ord.) Although hashStableName can map different stable names to the same hash value, collisions are rare, so the StableBind lists rarely have more than one element and the linear search is cheap.

type SM k v = I.IntMap [StableBind k v]  – Stable map
 
data StableBind k v = ∀ a. HasType a => SB (StableName (k a)) (v a)

The reason for hiding the type parameter a in StableName is so that different bindings can be for different types.

The key tricky bit is managing static typing while searching for a particular StableName a in a [StableBind]. Here’s my implementation:

blookup :: ∀ k v a. HasType a =>
           StableName (k a) -> [StableBind k v] -> Maybe (v a)
blookup stk = look
 where
   look :: [StableBind k v] -> Maybe (v a)
   look [] = Nothing
   look (SB stk’ v : binds’) 
     | Just Refl <- tya `tyEq` typeOf2 stk’, stk == stk’ = Just v
     | otherwise                                         = look binds’
   tya :: Type a
   tya = typeT

The crucial magic bit is

tyEq :: Type a -> Type b -> Maybe (a :=: b)

where a :=: b represents a proof that the types a and b are the same type. The proof type has a simple GADT representation:

data (:=:) :: * -> * -> * where Refl :: a :=: a

This simple type definition ensures that only valid type-equality proofs can exist. Well, except for ⊥. The guard’s pattern match with Just Refl will force evaluation, so that ⊥ can’t sneak by us. That match also informs the type-checker that stk and stk' are stable names of the same type in that clause, which then makes stk == stk' be well-typed, and makes Just v have the required type, i.e., Maybe (v a).

Finally, the typeOf2 function is a simple helper that peels off two type constructors and extracts a Type:

typeOf2 :: HasType a => g (f a) -> Type a

Wishing for more

The type of memo above is too restrictive for my uses. It only handles polymorphic functions of type k a -> v a, and only with the single constraint HasType a.

The reason I want lazy memoization now is that I’m compressing expressions to maximize representation sharing, as John Hughes described in Lazy Memo-functions. Once sharing is maximized, pointer-based memoization works better, because equal values are pointer-equal. To compress an expression, simply use a memoized copy function, as John suggested.

compress :: HasType a => E a -> E a
compress e = mcopy e
 where
   mcopy, copy :: HasType b => E b -> E b
   – Memo version
   mcopy = memo copy
   – Copier, with memo-copied components
   copy (u :^ v)  = appM (mcopy u) (mcopy v)
   copy (Lam v b) = lamM v (mcopy b)
   copy e         = e
   – memoized constructors
   appM :: (HasType a, HasType b) => E (a -> b) -> E a -> E b
   appM = memo2 (:^)
   lamM :: (HasType a, HasType b) => V a -> E b -> E (a -> b)
   lamM = memo2 Lam

The memo2 function is defined in terms of memo, using some some newtype trickery. Its type:

memo2 :: HasType a =>
         (k a -> l a -> v a) -> (k a -> l a -> v a)

But, sigh, the (:^) and Lam constructors I’m trying to memoize do not have the required types. My higher-order-polymorphic memo functions do not have flexible enough types.

And this is where I’m stuck.

I’d appreciate your ideas and suggestions.

There has been a scurry of reaction on twitter and reddit to Robert Fischer’s post saying that Scala is Not a Functional Programming Language. James Iry responded by saying that analogous reasoning leads to the conclusion that Erlang is Not Functional

My first inclination was to suggest that Haskell, as commonly practiced (with monadic IO), is not a functional language either. Instead, I’m going to explain how it is that the C language is purely functional.

The story of C

First, let me make that claim more precise. What I really mean is that almost everyone who “writes C programs” is really programming in a purely functional language. Modulo some minor historical accidents.

“C programmers” really program not in C, but in the purely functional language cpp. As with any purely functional language, cpp consists only of (nestable) expressions, not statements. Now here’s the clever part: when evaluated (not executed), a cpp expression yields a (pure) value of type C, which is an ADT (abstract type) that represents imperative programs. That value of type C is then executed (not evaluated) by the cpp language’s RTS (run-time system). As a clever optimization, cpp’s RTS actually includes a code generator, considerably improving performance over more naïve implementations of the C abstract data type.

(So now you can see that, “C programmer” is a almost always a misnomer when applied to a person. Instead people are cpp programmers, and cpp programs are the real C programmers (producers of C). I don’t think I can buck this misnomer, so I’ll stay with the herd and use “C programming” to mean cpp programming.)

In this way, the geniuses Brian Kernighan and Dennis Ritchie applied monads (from category theory) to programming language design considerably before the work of Moggi and Wadler. (Even earlier examples of this idea can be found, so I’m taking liberty with history, choosing to give K&R credit for the sake of this post.)

Now along the way, some mistakes were made that tarnished the theoretical beauty of cpp+C:

• Although cpp is in spirit purely functional, pragmatists insisted on unnecessary and the theoretically awkward constructs #undef, which allows a single name to be re-defined.

• Scoping rules are not as clean as, say, the lambda calculus or Scheme, (But hey — even John McCarthy got scoping wrong.)

• The C ADT is implemented simply as String (or char *, for you type theorists, using a notation from Kleene), and the representation is exposed rather than hidden, so that cpp programs operate directly on strings. The wisdom of data abstraction caught on later.

Fortunately for purists, the relatively obscure programming language Haskell restored the original untarnished beauty of K&R’s vision by fixing these defects. The type system was modernized, scoping rules improved, and the C type (renamed to “IO“, to avoid expensive legal battles) made abstract.

(Admittedly, Haskell also had some shameful pre-teen influences from hooligans like Church, Curry, Landin, and Milner, before it settled its true cpp+C nature, under the guiding influence of Wadler (under the influence of Moggi).)

What about Haskell?

Which leads to the question: is Haskell+IO a purely functional programming language?

Sure it is, even as much as its predecessor C (more precisely, cpp+C).

Some who ought to know better would claim that Haskell+IO is only technically pure. (See claims and follow-up discussion, in response to a remark from James Iry.)

I must then respond that, in that case, even C programming is only technically pure.

Which is absurd.

Lately I’ve been learning that some programming principles I treasure are not widely shared among my Haskell comrades. Or at least not widely among those I’ve been hearing from. I was feeling bummed, so I decided to write this post, in order to help me process the news and to see who resonates with what I’m looking for.

One of the principles I’m talking about is that the value of a closed expression (one not containing free variables) depends solely on the expression itself — not influenced by the dynamic conditions under which it is executed. I relate to this principle as the soul of functional programming and of referential transparency in particular.

Recently I encountered two facts about standard Haskell libraries that I have trouble reconciling with this principle.

• The meaning of Int operations in overflow situations is machine-dependent. Typically they use 32 bits when running on 32-bit machine and 64 bits when running on 64-bit machines. Implementations are free to use as few as 29 bits. Thus the value of the expression “2^32 == (0 ::Int)” may be either False or True, depending on the dynamic conditions which it is evaluated.
• The expression “System.Info.os” has type String, although its value as a sequence of characters depends on the circumstances of its execution. (Similarly for the other exports from System.Info. Hm. I just noticed that the module is labeled as “portable”. Typo? Joke?)

Although I’ve been programming primarily in Haskell since around 1995, I didn’t realize that these implementation-dependent meanings were there. As in many romantic relationships, I suppose I’ve been seeing Haskell not as she is, but as I idealized her to be.

There’s another principle that is closely related to the one above and even more fundamental to me: every type has a precise, specific, and preferably simple denotation. If an expression e has type T, then the meaning (value) of e is a member of the collection denoted by T. For instance, I think of the meaning of the type String, i.e., of [Char], as being sequences of characters. Well, not quite that simple, because it also contains some partially defined sequences and has a partial information ordering (non-flat in this case). Given this second principle, if os :: String, then the meaning of os is some sequence of characters. Assuming the sequence is finite and non-partial, it can be written down as a literal string, and that literal can be substituted for every occurrence of “os” in a program, without changing the program’s meaning. However, os evaluates to “linux” on my machine and evaluates to “darwin” on my friend Bob’s machine, so substituting any literal string for “os” would change the meaning, as observable on at least one of these machines.

Now I realize I’m really talking about standard Haskell libraries, not Haskell itself. When I discussed my confusion & dismay in the #haskell chat room, someone suggested explaining these semantic differences in terms of different libraries and hence different programs (if one takes programs to include the libraries they use). One would not expect different programs (due to different libraries) to have the same meaning.

I understand this different-library perspective — in a literal way. And yet I’m not really satisfied. What I get is that standard libraries are “standard” in signature (form), not in meaning (substance). With no promises about semantic commonality, I don’t know how standard libraries can be useful.

Another perspective that came up on #haskell was that the kind of semantic consistency I’m looking for is impossible, because of possibilities of failure. For instance, evaluating an expression might one time fail due to memory exhaustion, while succeeding (perhaps just barely) on another attempt. After mulling over that point, I’d like to weaken my principle a little. Instead of asking that all evaluations of an expression yield same value, I ask that all evaluations of an expression yield consistent answers. By “consistent” I mean in the sense of information content. Answers don’t have to agree, but they must not disagree. Failures like exhausted memory are modeled as ⊥, which is called “bottom” because it is the bottom of the information partial ordering. It contains no information and so is consistent with every value, disagreeing with no value. More precisely, values are consistent when they have a shared upper (information) bound, and inconsistent when they don’t. The value ⊥ means i-don’t-know, and the value (1,⊥,3) means (1, i-don’t-know, 3). The consistent-value principle accepts possible failures due to finite resources and hardware failure, while rejecting “linux” vs “darwin” for System.Info.os or False vs True for “2^32 == (0 ::Int). It also accepts System.Info.os :: IO String, which is the type I would have expected, because the semantics of IO String is big enough to accommodate dependence on dynamic conditions.

If you also cherish the principles I mention above, I’d love to hear from you.

I have another paper draft for submission to ICFP 2009. This one is called Beautiful differentiation, The paper is a culmination of the several posts I’ve written on derivatives and automatic differentiation (AD). I’m happy with how the derivation keeps getting simpler. Now I’ve boiled extremely general higher-order AD down to a Functor and Applicative morphism.

I’d love to get some readings and feedback. I’m a bit over the page the limit, so I’ll have to do some trimming before submitting.

The abstract:

Automatic differentiation (AD) is a precise, efficient, and convenient method for computing derivatives of functions. Its implementation can be quite simple even when extended to compute all of the higher-order derivatives as well. The higher-dimensional case has also been tackled, though with extra complexity. This paper develops an implementation of higher-dimensional, higher-order differentiation in the extremely general and elegant setting of calculus on manifolds and derives that implementation from a simple and precise specification.

In order to motivate and discover the implementation, the paper poses the question “What does AD mean, independently of implementation?” An answer arises in the form of naturality of sampling a function and its derivative. Automatic differentiation flows out of this naturality condition, together with the chain rule. Graduating from first-order to higher-order AD corresponds to sampling all derivatives instead of just one. Next, the notion of a derivative is generalized via the notions of vector space and linear maps. The specification of AD adapts to this elegant and very general setting, which even simplifies the development.

You can get the paper and see current errata here.

The submission deadline is March 2, so comments before then are most helpful to me.

Enjoy, and thanks!

I’ve just finished a draft of a paper called Denotational design with type class morphisms, for submission to ICFP 2009. The paper is on a theme I’ve explored in several posts, which is semantics-based design, guided by type class morphisms.

I’d love to get some readings and feedback. Pointers to related work would be particularly appreciated, as well as what’s unclear and what could be cut. It’s an entire page over the limit, so I’ll have to do some trimming before submitting.

The abstract:

Type classes provide a mechanism for varied implementations of standard interfaces. Many of these interfaces are founded in mathematical tradition and so have regularity not only of types but also of properties (laws) that must hold. Types and properties give strong guidance to the library implementor, while leaving freedom as well. Some of the remaining freedom is in how the implementation works, and some is in what it accomplishes.

To give additional guidance to the what, without impinging on the how, this paper proposes a principle of type class morphisms (TCMs), which further refines the compositional style of denotational semantics. The TCM idea is simply that the instance’s meaning is the meaning’s instance. This principle determines the meaning of each type class instance, and hence defines correctness of implementation. In some cases, it also provides a systematic guide to implementation, and in some cases, valuable design feedback.

The paper is illustrated with several examples of type, meanings, and morphisms.

You can get the paper and see current errata here.

The submission deadline is March 2, so comments before then are most helpful to me.

Enjoy, and thanks!

In What is automatic differentiation, and why does it work?, I gave a semantic model that explains what automatic differentiation (AD) accomplishes. Correct implementations then flowed from that model, by applying the principle of type class morphisms. (An instance’s interpretation is the interpretation’s instance).

I’ve had a nagging discomfort about the role of the chain rule in AD, with an intuition that the chain rule can carry a more central role the the specification and implementation. This post gives a variation on the previous AD post that carries the chain rule further into the reasining and implementation, leading to simpler correctness proofs and a nearly unaltered implementation.

Finally, as a bonus, I’ll show how GHC rewrite rules enable an even simpler and more modular implementation.

I’ve included some optional content, including exercises. You can see my answers to the exercises by examining the HTML.

As before, I’ll start with a limited form of differentiation that works for functions of a scalar (1D) domain, where one can identify derivative values with regular values:

deriv :: Num a => (a -> a) -> (a -> a) –  simplification

The development below extends to higher-order derivatives and higher-dimensional domains.

The chain rule

At the heart of AD is the chain rule:

deriv (g . f) x == deriv g (f x) * deriv f x

Equivalently,

deriv (g . f) == (deriv g . f) * deriv f

where this (*) is on functions: (*) = liftA2 (*) == \ h k x -> h x * k x.

The traditional forward AD formulation is based on the chain rule but is not as symmetric as the chain rule. In the function compositions g . f considered, g is always simple, while f may be arbitrarily complex. (I think the reverse true for reverse-mode AD.) What might we find if we delay introducing this asymmetry?

A direct implementation of the chain rule

The chain rule applies to functions and their derivatives, so let’s formulate a direct implementation. Start with a type for holding two functions:

data FD a = FD (a -> a) (a -> a)

FD is used to hold functions and their derivatives:

toFD :: (a -> a) -> FD a
toFD f = FD f (deriv f)

We do not have an implementation of deriv, so toFD here is part of the specification only, not the implementation.

Now we can specify a composition operator on FD:

(~.~) :: FD a -> FD a -> FD a

We’ll want (~.~) to represent composition of functions, where we have access to the derivatives as well. That is, (~.~) must satisfy:

toFD (g . f) == toFD g ~.~ toFD f

The implementation and its correctness follow from the chain rule:

FD g g' ~.~ FD f f' = FD (g . f) ((g’ . f) * f’)

(Exercise solutions are in the post’s HTML.)

From function to values

The FD type and its composition operator implement the chain rule quite directly. However, they are not suitable for AD, which operates on the values (range) of a function and of its derivative.

Let’s start over with the usual AD value representation:

data D a = D a a

Previously, I defined this ideal construction function:

toD :: (a -> a) -> a -> D a
toD f x = D (f x) (deriv f x)
 
– or
toD == liftA2 D f (deriv f)

Instead, let’s now define toD in terms of toFD. First, how do the FD and D representations relate?

fdAt :: FD a -> (a -> D a)
fdAt (FD f f’) = liftA2 D f f’

Then we can define toD:

toD = fdAt . toFD

Again, toD isn’t executable with this definition, because toFD isn’t (because deriv isn’t). As before, toD must be eliminated in our journey from specification to implementation.

fromD :: D a -> a -> (a -> a)

toD (fromD d x) x == d

toD'   :: a -> (a -> a) ->   D a
fromD’ :: a ->    D a   -> (a -> a)
 
toD’   = flip toD
fromD’ = flip fromD

toD' x . fromD' x == id

A general, value-friendly chain rule

In What is AD …?, I defined correctness of the numeric class instances D by saying that toD must be a type class morphism for each of the numeric classes it implements. For example, let’s take the sin method. The other unary methods will work just like it. The morphism property:

toD (sin u) == sin (toD u)

Because of numeric overloading on functions, this property is equivalent to a more explicit one:

toD (sin . u) == sin . toD u

The sin on the left is on numbers, and the sin on the right is on D a.

Let’s suppose we have a function adiff (for automatic differentiation) such that for all g and f,

toD (g . f) == adiff g . toD f      – specification of adiff
 
adiff :: Num => (a -> a) -> (D a -> D a)

Then our goal would become

adiff sin . toD u == sin . toD u

and a correct definition of sin would be immediate, as would be the other definitions:

sin  = adiff sin
sqrt = adiff sqrt
…

Note that the adiff specification above implies that for all g,

toD g == adiff g . toD id

adiff g (D a a’) = D (g a) (deriv g a * a’)

The adiff function satisfies a more symmetric property as well. It distributes over composition:

adiff (h . g) == adiff h . adiff g

Moreover, adiff maps the identity to the identity: adiff id = id.

toD g == adiff g . toD id

adiff (h . g) == adiff h . adiff g

adiff g . toD f == toD (g . f)

Back to an implementation

We’re still not quite done, since adiff depends on deriv, which doesn’t have an implementation. Let’s separate out the problematic deriv by refactoring adiff:

adiff g = g >-< deriv g

where

infix  0 >-<
(>-<) :: Num a => (a -> a) -> (a -> a) -> (D a -> D a)
(g >-< g’) (D a a’) = D (g a) (g’ a * a’)

After inlining this definition of adiff, the method definitions are

sin  = sin  >-< deriv sin
sqrt = sqrt >-< deriv sqrt
…

Every remaining use of deriv is applied to a function whose derivative is known, so we can replace each use.

sin  = sin  >-< cos
sqrt = sqrt >-< recip (2 * sqrt)
…

Now we have an executable implementation again. These method definitions and the definition of (>-<) are exactly as in What is automatic differentiation, and why does it work?.

Fun with rules

Let’s back up to our more elegant method definitions using adiff:

sin  = adiff sin
sqrt = adiff sqrt
…

We made these definitions executable in spite of their appeal to the non-executable deriv by (a) refactoring adiff to split the deriv from the residual function (>-<), (b) inlining adiff, and (c) rewriting applications of deriv with known derivative rules.

Now let’s get GHC to do these steps for us.

List the derivatives of known functions:

{-# RULES
 
"deriv negate"  deriv negate  =  -1
"deriv abs"     deriv abs     =  signum
"deriv signum"  deriv signum  =  0
"deriv recip"   deriv recip   =  - sqr recip
"deriv exp"     deriv exp     =  exp
"deriv log"     deriv log     =  recip
"deriv sqrt"    deriv sqrt    =  recip (2 * sqrt)
"deriv sin"     deriv sin     =  cos
"deriv cos"     deriv cos     =  - sin
"deriv asin"    deriv asin    =  recip (sqrt (1-sqr))
"deriv acos"    deriv acos    =  recip (- sqrt (1-sqr))
"deriv atan"    deriv atan    =  recip (1+sqr)
"deriv sinh"    deriv sinh    =  cosh
"deriv cosh"    deriv cosh    =  sinh
"deriv asinh"   deriv asinh   =  recip (sqrt (1+sqr))
"deriv acosh"   deriv acosh   =  recip (- sqrt (sqr-1))
"deriv atanh"   deriv atanh   =  recip (1-sqr)
 
 #-}

Notice that these definitions are simpler and more modular than the standard differentiation rules, as they do not have the chain rule mixed in. For instance, compare (a) deriv sin = cos, (b) deriv (sin u) == cos u * deriv u, and (c) deriv (sin u) x == cos u x * deriv u x.

Now we can use the incredibly simple adiff-based definitions of our methods, e.g., asin = adiff asin.

The definition of adiff must get inlined so as to reveal the deriv applications, which then get rewritten according to the rules. Fortunately, the adiff definition is tiny, which encourages its inlining. We could add an INLINE pragma as a reminder. GHC requires that a definition must be given deriv, even it all uses are rewritten away, so use the following

deriv = error "deriv: undefined.  Missing rewrite rule?"

Thanks to my time at Microsoft Research (1994-2002), I was able to live for a while (modestly) on asset growth. Last year I started working in earnest on two libraries, Reactive (functional reactive programming) and FieldTrip (functional 3D), plus some supporting libraries. I placed these libraries all under the most liberal license I know, which is BSD3. I’m more enthusiastic than ever about my functional programming work and am enjoying active involvement with the Haskell community.

With the recent economic meltdown, my old means of sustainable income ended, and now I’m looking for a replacement. I’m not yet in crisis, so I have time to make some thoughtful decisions and even take some risk. Rather than abandoning Reactive, FieldTrip, and related projects (some new), I’m looking for ways to continue these projects while building potential for future income related to them. At the same time, it’s very important to me to keep these projects open so as to advance purely functional techniques & tools, as well as to have enjoyable creative connections, and to get feedback & help.

For these reasons, I’m now considering licensing future releases of some my libraries for non-commercial use, with commercial uses to be arranged as separate licenses. I know almost nothing about licensing issues, because I haven’t been interested, and I’ve always wanted maximum freedom for all users.

So, I’m looking for help in choosing a software license that enables & encourages a creative community, while preserving opportunity to ask for some portion of return in future for-profit uses. If people have alternative perspectives how to achieve my goals without changing license terms, I’m interested in hearing them as well. I am not trying to “make a killing”, just a living, so that I can keep doing what I love and share it with others.

Bertrand Russell remarked that

Everything is vague to a degree you do not realize till you have tried to make it precise.

I’m mulling over automatic differentiation (AD) again, neatening up previous posts on derivatives and on linear maps, working them into a coherent whole for an ICFP submission. I understand the mechanics and some of the reasons for its correctness. After all, it’s “just the chain rule”.

As usual, in the process of writing, I bumped up against Russell’s principle. I felt a growing uneasiness and realized that I didn’t understand AD in the way I like to understand software, namely,

• What does it mean, independently of implementation?
• How do the implementation and its correctness flow gracefully from that meaning?
• Where else might we go, guided by answers to the first two questions?

Ever since writing Simply efficient functional reactivity, the idea of type class morphisms keeps popping up for me as a framework in which to ask and answer these questions. To my delight, this framework gives me new and more satisfying insight into automatic differentiation.

What’s a derivative?

My first guess is that AD has something to do with derivatives, which then raises the question of what is a derivative. For now, I’m going to substitute a popular but problematic answer to that question and say that

deriv :: ... => (a -> b) -> (a -> b) –  simplification

As discussed in What is a derivative, really?, the popular answer has limited usefulness, applying just to scalar (one-dimensional) domain. The real deal involves distinguishing the type b from the type a :-* b of linear maps from a to b.

deriv :: (VectorSpace u, VectorSpace v) => (u -> v) -> (u -> (u :-* v))

Why care about derivatives?

Derivatives are useful in a variety of application areas, including root-finding, optimization, curve and surface tessellation, and computation of surface normals for 3D rendering. Considering the usefulness of derivatives, it is worthwhile to find software methods that are

• simple (to implement and verify),
• convenient,
• accurate,
• efficient, and
• general.

What isn’t AD?

Numeric approximation

One differentiation method numeric approximation, using simple finite differences. This method is based on the definition of (scalar) derivative:

The left-hand side reads “the derivative of f at x“.

To approximate the derivative, use

for a small value of h. While very simple, this method is often inaccurate, due to choosing either too large or too small a value for h. (Small values of h lead to rounding errors.) More sophisticated variations improve accuracy while sacrificing simplicity.

Symbolic differentiation

A second method is symbolic differentiation. Instead of using the definition of deriv directly, the symbolic method uses a collection of rules, such as those below:

deriv (u + v)   == deriv u + deriv v
deriv (u * v)   == deriv v * u + deriv u * v
deriv (- u)     == - deriv u
deriv (exp u)   == deriv u * exp u
deriv (log u)   == deriv u / u
deriv (sqrt u)  == deriv u / (2 * sqrt u)
deriv (sin u)   == deriv u * cos u
deriv (cos u)   == deriv u * (- sin u)
deriv (asin u)  == deriv u/(sqrt (1 - u^2))
deriv (acos u)  == - deriv u/(sqrt (1 - u^2))
deriv (atan u)  == deriv u / (u^2 + 1)
deriv (sinh u)  == deriv u * cosh u
deriv (cosh u)  == deriv u * sinh u
deriv (asinh u) == deriv u / (sqrt (u^2 + 1))
deriv (acosh u) == - deriv u / (sqrt (u^2 - 1))
deriv (atanh u) == deriv u / (1 - u^2)

There are two main drawbacks to the symbolic approach to differentiation.

• As a symbolic method, it requires access to and transformation of source code, and placing restrictions on that source code.
• Implementations tend to be quite expensive and in particular perform redundant computation. (I wonder if this latter criticism is a straw man argument. Are symbolic methods necessarily expensive or just when implemented naïvely? For instance, can simply memoized symbolic differentiation be nearly as cheap as AD?)

What is AD and how does it work?

A third method is the topic of this post, namely automatic differentiation (also called “algorithmic differentiation”), or “AD”. The idea of AD is to simultaneously manipulate values and derivatives. Overloading of the standard numerical operations (and literals) makes this combined manipulation as convenient and elegant as manipulating values without derivatives.

The implementation of AD can be quite simple, as shown below:

data D a = D a a deriving (Eq,Show)
 
instance Num a => Num (D a) where
  D x x’ + D y y’ = D (x+y) (x’+y’)
  D x x’ * D y y’ = D (x*y) (y’*x + x’*y)
  fromInteger x   = D (fromInteger x) 0
  negate (D x x’) = D (negate x) (negate x’)
  signum (D x _ ) = D (signum x) 0
  abs    (D x x’) = D (abs x) (x’ * signum x)
 
instance Fractional x => Fractional (D x) where
  fromRational x  = D (fromRational x) 0
  recip  (D x x’) = D (recip x) (x’ / sqr x)
 
sqr :: Num a => a -> a
sqr x = x * x
 
instance Floating x => Floating (D x) where
  pi              = D pi 0
  exp    (D x x’) = D (exp    x) (x’ * exp x)
  log    (D x x’) = D (log    x) (x’ / x)
  sqrt   (D x x’) = D (sqrt   x) (x’ / (2 * sqrt x))
  sin    (D x x’) = D (sin    x) (x’ * cos x)
  cos    (D x x’) = D (cos    x) (x’ * (- sin x))
  asin   (D x x’) = D (asin   x) (x’ / sqrt (1 - sqr x))
  acos   (D x x’) = D (acos   x) (x’ / (-  sqrt (1 - sqr x)))
  – …

As an example, define

f1 :: Floating a => a -> a
f1 z = sqrt (3 * sin z)

and try it out in GHCi:

*Main> f1 (D 2 1)
D 1.6516332160855343 (-0.3779412091869595)

To test correctness, here is a symbolically differentiated version:

f2 :: Floating a => a -> D a
f2 x = D (f1 x) (3 * cos x / (2 * sqrt (3 * sin x)))

Try it out:

*Main> f2 2
D 1.6516332160855343 (-0.3779412091869595)

The can also be made prettier, as in Beautiful differentiation. Add an operator that captures the chain rule, which is behind the differentiation laws listed above.

infix  0 >-<
(>-<) :: Num a => (a -> a) -> (a -> a) -> (D a -> D a)
(f >-< f’) (D a a’) = D (f a) (a’ * f’ a)

Then, e.g.,

instance Floating a => Floating (D a) where
  pi   = D pi 0
  exp  = exp  >-< exp
  log  = log  >-< recip
  sqrt = sqrt >-< recip (2 * sqrt)
  sin  = sin  >-< cos
  cos  = cos  >-< - sin
  asin = asin >-< recip (sqrt (1-sqr))
  acos = acos >-< recip (- sqrt (1-sqr))
  – …

This AD implementation satisfy most of our criteria very well:

• It is simple to implement and verify. Both the implementation and its correctness follow directly from the familiar laws given above.
• It is convenient to use, as shown with f1 above.
• It is accurate, as shown above, producing exactly the same result as the symbolic differentiated code (f2).
• It is efficient, involving no iteration or redundant computation.

The formulation above does less well with generality:

• It computes only first derivatives.
• It applies (correctly) only to functions over a scalar (one-dimensional) domain, excluding even complex numbers.

Both of these limitations are removed in the post Higher-dimensional, higher-order derivatives, functionally.

What is AD, really?

How do we know whether this AD implementation is correct? We can’t begin to address this question until we first answer a more fundamental one: what does its correctness mean?

A model for AD

I’m pretty sure AD has something to do with calculating a function’s values and derivative values simultaneously, so I’ll start there.

withD :: ... => (a -> a) -> (a -> D a)
withD f x = D (f x) (deriv f x)

Or, in point-free form,

withD f = liftA2 D f (deriv f)

Since, on functions,

liftA2 h f g = \ x -> h (f x) (g x)

We don’t have an implementation of deriv, so this definition of withD will serve as a specification, not an implementation.

If AD is structured as type class instances, then I’d want there to be a compelling interpretation function that is faithful to each of those classes, as in the principle of type class morphisms, which is to say that the interpretation of each method corresponds to the same method for the interpretation.

For AD, the interpretation function is withD. It’s turned around this time (mapping to instead of from our type), as is sometimes the case. The Num, Fractional, and Floating morphisms provide the specifications of the instances:

withD (u + v) == withD u + withD v
withD (u * v) == withD u * withD v
withD (sin u) == sin (withD u)
…

Note here that the methods on the left are on a -> a, and on the right are on a -> D a.

These (morphism) properties exactly define correctness of any implementation of AD, answering my first question:

What does it mean, independently of implementation?

Deriving an AD implementation

Now that we have a simple, formal specification of AD (numeric type class morphisms), we can try to prove that the implementation above satisfies the specification. Better yet, let’s do the reverse, and use the morphism properties to discover the implementation, and prove it correct in the process.

Addition

Here is the addition specification:

withD (u + v) == withD u + withD v

Start with the left-hand side:

   withD (u + v)
==   {- def of withD -}
   liftA2 D (u + v) (deriv (u + v))
==   {- deriv rule for (+) -}
   liftA2 D (u + v) (deriv u + deriv v)
==   {- liftA2 on functions -}
   \ x -> D ((u + v) x) ((deriv u + deriv v) x)
==   {- (+) on functions -}
   \ x -> D (u x + v x) (deriv u x + deriv v x)

Then start over with the right-hand side:

   withD u + withD v
==   {- (+) on functions -}
   \ x -> withD u x + withD v x
==   {- def of withD -}
   \ x -> D (u x) (deriv u x) + D (v x) (deriv v x)

We need a definition of (+) on D that makes these two final forms equal, i.e.,

   \ x -> D (u x + v x) (deriv u x + deriv v x)
==
   \ x -> D (u x) (deriv u x) + D (v x) (deriv v x)

An easy choice is

D a a' + D b b' = D (a + b) (a’ + b’)

This definition provides the missing link and that completes the proof that

withD (u + v) == withD u + withD v

Multiplication

The specification:

withD (u * v) == withD u * withD v

Reason similarly to the addition case. Begin with the left hand side:

   withD (u * v)
== {- def of withD -}
   liftA2 D (u * v) (deriv (u * v))
== {- deriv rule for (*) -}
   liftA2 D (u * v) (deriv u * v + deriv v * u)
== {- liftA2 on functions -}
   \ x -> D ((u * v) x) ((deriv u * v + deriv v * u) x)
== {- (*) and (+) on functions -}
   \ x -> D (u x * v x) (deriv u x * v x + * deriv v x * u x)

Then start over with the right-hand side:

   withD u * withD v
== {- (*) on functions -}
   \ x -> withD u x * withD v x
== {- def of withD -}
   \ x -> D (u x) (deriv u x) * D (v x) (deriv v x)

Sufficient definition:

D a a' * D b b' = D (a + b) (a’ * b + b’ * a)

Sine

Specification:

withD (sin u) == sin (withD u)

Begin with the left hand side:

   withD (sin u)
== {- def of withD -}
   liftA2 D (sin u) (deriv (sin u))
== {- deriv rule for sin -}
   liftA2 D (sin u) (deriv u * cos u)
== {- liftA2 on functions -}
   \ x -> D ((sin u) x) ((deriv u * cos u) x)
== {- sin, (*) and cos on functions -}
   \ x -> D (sin (u x)) (deriv u x * cos (u x))

Then start over with the right-hand side:

   sin (withD u)
== {- sin on functions -}
   \ x -> sin (withD u x)
== {- def of withD -}
   \ x -> sin (D (u x) (deriv u x))

Sufficient definition:

sin (D a a’) = D (sin a) (a’ * cos a)

Or, using the chain rule operator,

sin = sin >-< cos

The whole implementation can be derived in exactly this style, answering my second question:

How does the implementation and its correctness flow gracefully from that meaning?

Higher-order derivatives

Given answers to the first two questions, let’s, turn to the third:

Where else might we go, guided by answers to the first two questions?

Jerzy Karczmarczuk extended the D representation above to an infinite “lazy tower of derivatives”, in the paper Functional Differentiation of Computer Programs.

data D a = D a (D a)

The withD function easily adapts to this new D type:

withD :: ... => (a -> a) -> (a -> D a)
withD f x = D (f x) (withD (deriv f) x)

or

withD f = liftA2 D f (withD (deriv f))

These definitions were not brilliant insights. I looked for the simplest, type-correct possibility (without using ⊥).

Similarly, I’ll try tweaking the previous derivations and see what pops out.

Addition

Left-hand side:

   withD (u + v)
==   {- def of withD -}
   liftA2 D (u + v) (withD (deriv (u + v)))
==   {- deriv rule for (+) -}
   liftA2 D (u + v) (withD (deriv u + deriv v))
==   {- (fixed-point) induction withD and (+) -}
   liftA2 D (u + v) (withD (deriv u) + withD (deriv v))
==   {- def of liftA2 and (+) on functions -}
   \ x -> D (u x + v x) (withD (deriv u) x + withD (deriv v) x)

Right-hand side:

   withD u + withD v
==   {- (+) on functions -}
   \ x -> withD u x + withD v x
==   {- def of withD -}
   \ x -> D (u x) (withD (deriv u x)) + D (v x) (withD (deriv v x))

Again, we need a definition of (+) on D that makes the LHS and RHS final forms equal, i.e.,

   \ x -> D (u x + v x) (withD (deriv u) x + with (deriv v) x)
==
   \ x -> D (u x) (withD (deriv u) x) + D (v x) (withD (deriv v) x)

Again, an easy choice is

D a a' + D b b' = D (a + b) (a’ + b’)

Multiplication

Left-hand side:

   withD (u * v)
==   {- def of withD -}
   liftA2 D (u * v) (withD (deriv (u * v)))
==   {- deriv rule for (*) -}
   liftA2 D (u * v) (withD (deriv u * v + deriv v * u))
==   {- induction for withD/(+) -}
   liftA2 D (u * v) (withD (deriv u * v) + withD (deriv v * u))
==   {- induction for withD/(*) -}
   liftA2 D (u * v) (withD (deriv u) * withD v + withD (deriv v) * withD u)
==   {- liftA2, (*), (+) on functions -}
   \ x -> liftA2 D (u x * v x) (withD (deriv u) x * withD v x + withD (deriv v) x * withD u x)

Right-hand side:

   withD u * withD v
==   {- def of withD -}
   liftA2 D u (withD (deriv u)) * liftA2 D v (withD (deriv v))
==   {- liftA2 and (*) on functions -}
   \ x -> D (u x) (withD (deriv u) x) * D (v x) (withD (deriv v) x)

A sufficient definition:

a@(D a0 a’) * b@(D b0 b’) = D (a0 + b0) (a’ * b + b’ * a)

Because

withD u x == D (u x) (withD (deriv u) x)
 
withD v x == D (v x) (withD (deriv v) x)

Sine

Left-hand side:

   withD (sin u)
==   {- def of withD -}
   liftA2 D (sin u) (withD (deriv (sin u)))
==   {- deriv rule for sin -}
   liftA2 D (sin u) (withD (deriv u * cos u))
==   {- induction for withD/(*) -}
   liftA2 D (sin u) (withD (deriv u) * withD (cos u))
==   {- induction for withD/cos -}
   liftA2 D (sin u) (withD (deriv u) * cos (withD u))
==   {- liftA2, sin, cos and (*) on functions -}
   \ x -> D (sin (u x)) (withD (deriv u) x * cos (withD u x))

Right-hand side:

   sin (withD u)
==   {- def of withD -}
   sin (liftA2 D u (withD (deriv u)))
==   {- liftA2 and sin on functions -}
   \ x -> sin (D (u x) (withD (deriv u) x))

To make the LHS and RHS final forms equal, define

sin a@(D a0 a’) == D (sin a0) (a’ * cos a)

Higher-dimensional derivatives

I’ll save non-scalar (”multi-variate”) differentiation for another time. In addition to the considerations above, the key ideas are in Higher-dimensional, higher-order derivatives, functionally and Simpler, more efficient, functional linear maps.

I just reread Jason Foutz’s post Higher order multivariate automatic differentiation in Haskell, as I’m thinking about this topic again. I like his trick of using an IntMap to hold the partial derivatives and (recursively) the partials of those partials, etc.

Some thoughts:

• I bet one can eliminate the constant (C) case in Jason’s representation, and hence 3/4 of the cases to handle, without much loss in performance. He already has a fairly efficient representation of constants, which is a D with an empty IntMap.

• I imagine there’s also a nice generalization of the code for combining two finite maps used in his third multiply case. The code’s meaning and correctness follows from a model for those maps as total functions with missing elements denoting a default value (zero in this case).

• Jason’s data type reminds me of a sparse matrix representation, but cooler in how it’s infinitely nested. Perhaps depth n (starting with zero) is a sparse n-dimensional matrix.

• Finally, I suspect there’s a close connection between Jason’s IntMap-based implementation and my LinearMap-based implementation described in Higher-dimensional, higher-order derivatives, functionally and in Simpler, more efficient, functional linear maps. For the case of Rⁿ, my formulation uses a trie with entries for n basis elements, while Jason’s uses an IntMap (which is also a trie) with n entries (counting any implicit zeros).

I suspect Jason’s formulation is more efficient (since it optimizes the constant case), while mine is more statically typed and more flexible (since it handles more than Rⁿ).

For optimizing constants, I think I’d prefer having a single constructor with a Maybe for the derivatives, to eliminate code duplication.

I am still trying to understand the paper Lazy Multivariate Higher-Order Forward-Mode AD, with its management of various epsilons.

A final remark: I prefer the term “higher-dimensional” over the traditional “multivariate”. I hear classic syntax/semantics confusion in the latter.

“It’s obvious”

A recent thread on haskell-cafe included claims and counter-claims of what is “obvious”.

First,

O[b]viously, bottom [⊥] is not ()

Then a second writer,

Why is this obvious – I would argue that it’s “obvious” that bottom is () – the data type definition says there’s only one value in the type. […]

And a third,

It’s obvious because () is a defined value, while bottom is not - per definitionem.

Personally, I have long suffered unaware under the affliction of “obviousness” that ⊥ is not (), and I suspect many others have as well. My thanks to Bob for jostling me out of my preconceptions. After weighing some alternatives, I might make one choice or another. Still, I like being reminded that other possibilities are available.

I don’t mean to pick on these writers. They just happened to provide at-hand examples of a communication (anti-)pattern I often hear. Also, if you want to address the issue of whether necessarily () /= ⊥, I refer you to the haskell-cafe thread “Re: Laws and partial values”.

A fallacy

I understand discussions of what is “obvious” as being founded on a fallacy, namely believing that obviousness is a property of a thing itself, rather than of an individual’s or community’s mental habits (ruts). (See 2-Place and 1-Place Words.)

Creativity

Still, I wondered why I get so annoyed about the uses of “obvious” in this discussion and in others. (It’s never merely because “Someone is wrong on the Internet”.) Whenever I get bugged and I take the time to look under the surface of my emotional reaction, I find there’s something important & beautiful to me.

My reaction to “obvious” comes from my seeing it as injurious to creativity, which is something I treasure in myself and others. I understand “it’s obvious” to mean “I’m not curious”. Worse yet, in a debate, I hear it as a tactic for discouraging curiosity in others.

For me, creativity begins with and is sustained by curiosity. Creativity is what’s important & beautiful to me here. It’s a value instilled thoroughly & joyfully in me from a very young age by my mother, as curiosity was by my father.

I wonder if “It’s obvious that” is one of those verbal devices that are most appealing when untrue. For instance, “I’m sure that”, as in “I’m sure that your [sick] cat will be okay”. Perhaps “It’s obvious that” most often means “I don’t want to imagine alternatives”or, when used in argument, “I don’t want you to imagine alternatives”. Perhaps “I’m sure that” means “I’d like to be sure that”, or “I’d like you to be sure that”.

In praise of curiosity

Here is a quote from Albert Einstein:

The important thing is not to stop questioning. Curiosity has its own reason for existing. One cannot help but be in awe when he contemplates the mysteries of eternity, of life, of the marvelous structure of reality. It is enough if one tries merely to comprehend a little of this mystery every day. Never lose a holy curiosity.

And another:

I have no special talents. I am only passionately curious.

Today I stumbled across a document that speaks to curiosity and more in a way that I resonate with: Twelve Virtues of Rationality. I warmly recommend it.

This post continues from an idea of Ryan Ingram’s in an email thread How to make code least strict?.

A pretty story

Pattern matching in function definitions is very handy and has a declarative feel. For instance,

sum []     = 0
sum (x:xs) = x + sum xs

Simply replace “=” by “==” to read such a set of pattern clauses (partial definitions) as a collection of properties specifying a sum function:

• The sum of an empty list equals zero
• The sum of a (non-empty) list x:xs equals x plus the sum of the xs.

Moreover, these properties define the sum function, in that sum is the least-defined function that satisfies these two properties.

Guards have a similar style and meaning:

abs x | x <  0 = -x
abs x | x >= 0 =  x

Replacing “=” by “==” and guards by logical implication, we again have two properties that define abs:

x <  0 ==> abs x == -x
x >= 0 ==> abs x ==  x

O, the lies!

This pretty story is a lie, as becomes apparent when we look at overlapping clauses. For instance, we’re more likely to write abs without the second guard:

abs x | x <  0 = -x
abs x          =  x

A declarative of the second clause (∀ x. abs x == x) is false.

I’d more likely write

abs x | x < 0     = -x
      | otherwise =  x

which is all the more deceptive, since “otherwise” doesn’t really mean otherwise. It’s just a synonym for “True“.

Another subtle but common problem arises with definitions like the following, as pointed out by ChrisK in How to make code least strict?:

zip :: [a] -> [b] -> [(a,b)]
zip []      _       = []
zip _       []      = []
zip (x:xs’) (y:ys’) = (x,y) : zip xs’ ys’

These three clauses read like independently true properties for zip. The first two clauses overlap, but their values agree, so what could possibly go wrong with a declarative reading?

The problem is that there are really three flavors of lists, not two. This definition explicitly addresses the nil and cons cases, leaving ⊥.

By the definition above, the value of ‘zip [] ⊥‘ is indeed [], which is consistent with each clause. However, the value of ‘zip ⊥ []‘ is ⊥, because Haskell semantics says that each clause is tried in order, and the first clause forces evaluation of ⊥ when comparing it with []. This ⊥ value is inconsistent with reading the second clause as a property. Swapping the first two clauses fixes the second example but breaks the first one.

Is it possible to fix zip so that its meaning is consistent with these three properties? We seem to be stuck with an arbitrary bias, with strictness in the first or second argument.

Or are we?

Unambiguous choice

Ryan Ingram suggested using unamb, and I agree that it is just the ticket for dilemmas like zip above, where we want unbiased laziness. (See posts on unambiguous choice and especially Functional concurrency with unambiguous choice.) The unamb operator returns the more defined of its two arguments, which are required to be equal if neither is ⊥. This precondition allows unamb to have a concurrent implementation with nondeterministic scheduling, while retaining simple functional (referentially transparent) semantics (over its domain of definition).

As Ryan said:

Actually, I see a nice pattern here for unamb + pattern matching:

zip xs ys = foldr unamb undefined [p1 xs ys, p2 xs ys, p3 xs ys] where
    p1 [] _ = []
    p2 _ [] = []
    p3 (x:xs) (y:ys) = (x,y) : zip xs ys

Basically, split each pattern out into a separate function (which by definition is ⊥ if there is no match), then use unamb to combine them.

The invariant you need to maintain is that potentially overlapping pattern matches (p1 and p2, here) must return the same result.

With a little typeclass hackery you could turn this into

zip = unambPatterns [p1,p2,p3] where {- p1, p2, p3 as above -}

I liked Ryan’s unambPatterns idea very much, and then it occurred me that the necessary “typeclass hackery” is already part of the lub library, as described in the post Merging partial values. The lub operator (”least upper bound”, also written “⊔”), combines information from its arguments and is defined in different ways for different types (via a type class). For functions,

instance HasLub b => HasLub (a -> b) where
  f ⊔ g = \ a -> f a ⊔ g a

More succinctly, on functions, (⊔) = liftA2 (⊔).

Using this instance twice gives a (⊔) suitable for curried functions of two arguments, which turns out to give us almost exactly what we want for Ryan’s zip definitions.

zip‘ = lubs [p1,p2,p3]
 where
   p1 []     _      = []
   p2 _      []     = []
   p3 (x:xs) (y:ys) = (x,y) : zip‘ xs ys

where

lubs :: [a] -> a
lubs = foldr (⊔) undefined

The difference between zip and zip' shows up in inferred HasLub type constraints on a and b:

zip‘ :: (HasLub a, HasLub b) => [a] -> [b] -> [(a,b)]

Let’s see if this definition works:

*Data.Lub> zip‘ [] undefined :: [(Int,Int)]
[]
*Data.Lub> zip‘ undefined [] :: [(Int,Int)]
[]

Next, an example that requires some recursive calls:

*Data.Lub> zip‘ [10,20] (1 : 2 : undefined)
[(10,1),(20,2)]
*Data.Lub> zip‘ (1 : 2 : undefined) [10,20]
[(1,10),(2,20)]

Lazy and bias-free!

If you want to try out out this example, be sure to get at least version 0.1.9 of unamb. I tweaked the implementation to handle pattern-match failures gracefully.

Checking totality

One unfortunate aspect of this definition style is that the Haskell compiler can no longer reliably warn us about non-exhaustive pattern-based definitions. With warnings turned on, I get the following messages:

Warning: Pattern match(es) are non-exhaustive
         In the definition of `p1′: Patterns not matched: (_ : _) _
 
Warning: Pattern match(es) are non-exhaustive
         In the definition of `p2′: Patterns not matched: _ (_ : _)
 
Warning: Pattern match(es) are non-exhaustive
         In the definition of `p3′:
             Patterns not matched:
                 [] _
                 (_ : _) []

Perhaps a tool like Neil Mitchell’s Catch could be adapted to understand the semantics of unamb and lub (⊔) sufficiently to prove totality.

More possibilities

The zip' definition above places HasLub constraints on the type parameters a and b. The origin of these constraints is the HasLub instance for pairs, which is roughly the following:

instance (HasLub a, HasLub b) => HasLub (a,b) where
  (a,b) ⊔ (a’,b’) = (a ⊔ a’, b ⊔ b’)

This instance is subtly incorrect. See Merging partial values.

Thanks to this instance, each argument to (⊔) can contribute partial information to each half of the pair. (As a special case, each argument could contribute a half.)

Although I haven’t run into a use for this flexibility yet, I’m confident that there are very cool uses waiting to be discovered. Please let me know if you have any ideas.

I’ve been playing with a simple/general semantics for 3D. In the process, I was surprised to see that a key part of the semantics looks exactly like a key part of the semantics of functional reactivity as embodied in the library Reactive. A closer look revealed a closer connection still, as described in this post.

What is 3D rendering?

Most programmers think of 3D rendering as being about executing sequence of side-effects on frame buffer or some other mutable array of pixels. This way of thinking (sequences of side-effects) comes to us from the design of early sequential computers. Although computer hardware architecture has evolved a great deal, most programming languages, and hence most programming thinking, is still shaped by the this first sequential model. (See John Backus’s Turing Award lecture Can Programming Be Liberated from the von Neumann Style? A functional style and its algebra of programs.) The invention of monadic Imperative functional programming allows Haskellers to think and program within the imperative paradigm as well.

What’s a functional alternative? Rendering is a function from something to something else. Let’s call these somethings (3D) “Geometry” and (2D) “Image”, where Geometry and Image are types of functional (immutable) values.

type Rendering = Image Color
 
render :: Geometry -> Rendering

To simplify, I’m assuming a fixed view. What remains is to define what these two types mean and, secondarily, how to represent and implement them.

An upcoming post will suggest an answer for the meaning of Geometry. For now, think of it as a collection of curved and polygonal surfaces, i.e., the outsides (boundaries) of solid shapes. Each point on these surfaces has a location, a normal (perpendicular direction), and material properties (determining how light is reflected by and transmitted through the surface at the point). The geometry will contain light sources.

Next, what is the meaning of Image? A popular answer is that an image is a rectangular array of finite-precision encodings of color (e.g., with eight bits for each of red, blue, green and possibly opacity). This answer is leads to poor compositionality and complex meanings for operations like scaling and rotation, so I prefer another model. As in Pan, an image (the meaning of the type Image Color) is a function from infinite continuous 2D space to colors, where the Color type includes partial opacity. For motivation of this model and examples of its use, see Functional images and the corresponding Pan gallery of functional images. Composition occurs on infinite & continuous images.

After all composition is done, the resulting image can be sampled into a finite, rectangular array of finite precision color encodings. I’m talking about a conceptual/semantic pipeline. The implementation computes the finite sampling without having to compute the values for entire infinite image.

Rendering has several components. I’ll just address one and show how it relates to functional reactive programming (FRP).

Visual occlusion

One aspect of 3D rendering is hidden surface determination. Relative to the viewer’s position and orientation, some 3D objects may fully or partially occluded by nearer objects.

An image is a function of (infinite and continuous) 2D space, so specifying that function is determining its value at every sample point. Each point can correspond to a number of geometric objects, some closer and some further. If we assume for now that our colors are fully opaque, then we’ll need to know the color (after transformation and lighting) of the nearest surface point that is projected onto the sample point. (We’ll remove this opacity assumption later.)

Let’s consider how we’ll combine two Geometry values into one:

union :: Geometry -> Geometry -> Geometry

Because of occlusion, the render function cannot be compositional with respect to union. If it were, then there would exist a functions unionR such that

forall ga gb. render (ga `union` gb) == render ga `unionR` render gb

In other words, to render a union of two geometries, we can render each and combine the results.

The reason we can’t find such a unionR is that render doesn’t let unionR know how close each colored point is. A solution then is simple: add in the missing depth information:

type RenderingD = Image (Depth, Color)  – first try
 
renderD :: Geometry -> RenderingD

Now we have enough information for compositional rendering, i.e., we can define unionR such that

forall ga gb. renderD (ga `union` gb) == renderD ga `unionR` renderD gb

where

unionR :: RenderingD -> RenderingD -> RenderingD
 
unionR im im' p = if d <= d’ then (d,c) else (d’,c’)
 where
   (d ,c ) = im  p
   (d’,c’) = im’ p

When we’re done composing, we can discard the depths:

render g = snd . renderD g

or, with Semantic editor combinators:

render = (result.result) snd renderD

Simpler, prettier

The unionR is not very complicated, but still, I like to tease out common structure and reuse definitions wherever I can. The first thing I notice about unionR is that it works pointwise. That is, the value at a point is a function of the values of two other images at the same point. The pattern is captured by liftA2 on functions, thanks to the Applicative instance for functions.

liftA2 :: (b -> c -> d) -> (a -> b) -> (a -> c) -> (a -> d)

So that

unionR = liftA2 closer
 
closer (d,c) (d’,c’) = if d <= d’ then (d,c) else (d’,c’)

Or

closer dc@(d,_) dc’@(d’,_) = if d <= d’ then dc else dc’

Or even

closer = minBy fst

where

minBy f u v = if f u <= f v then u else v

This definition of unionR is not only simpler, it’s quite a bit more general, as type inference reveals:

unionR :: (Ord a, Applicative f) => f (a,b) -> f (a,b) -> f (a,b)
 
closer :: Ord a => (a,b) -> (a,b) -> (a,b)

Once again, simplicity and generality go hand-in-hand.

Another type class morphism

Let’s see if we can make union rendering simpler and more inevitable. Rendering is nearly a homomorphism. That is, render nearly distributes over union, but we have to replace union by unionR. I’d rather eliminate this discrepancy, ending up with

forall ga gb. renderD (ga `op` gb) == renderD ga `op` renderD gb

for some op that is equal to union on the left and unionR on the right. Since union and unionR have different types (with neither being a polymorphic instance of the other), op will have to be a method of some type class.

My favorite binary method is mappend, from Monoid, so let’s give it a try. Monoid requires there also to be an identity element mempty and that mappend be associative. For Geometry, we can define

instance Monoid Geometry where
  mempty  = emptyGeometry
  mappend = union

Images with depth are a little trickier. Image already has a Monoid instance, whose semantics is determined by the principle of type class morphisms, namely

The meaning of an instance is the instance of the meaning

The meaning of an image is a function, and that functions have a Monoid instance:

instance Monoid b => Monoid (a -> b) where
  mempty = const mempty
  f `mappend` g = \ a -> f a `mappend` g a

which simplifies nicely to a standard form, by using the Applicative instance for functions.

instance Applicative ((->) a) where
  pure      = const
  hf <*> xf = \ a -> (hf a) (xf a)
 
instance Monoid b => Monoid (a -> b) where
  mempty  = pure   mempty
  mappend = liftA2 mappend

We’re in luck. Since we’ve defined unionR as liftA2 closer, so we just need it to turn out that closer == mappend and that closer is associative and has an identity element.

However, closer is defined on pairs, and the standard Monoid instance on pairs doesn’t fit.

instance (Monoid a, Monoid b) => Monoid (a,b) where
  mempty = (mempty,mempty)
  (a,b) `mappend` (a’,b’) = (a `mappend` a’, b `mappend` b’)

To avoid this conflict, define a new data type to be used in place of pairs.

data DepthG d a = Depth d a  – first try

Alternatively,

newtype DepthG d a = Depth { unDepth :: (d,a) }

I’ll go with this latter version, as it turns out to be more convenient.

Then we can define our monoid:

instance Monoid (DepthG d a) where
  mempty  = Depth (maxBound,undefined)
  Depth p `mappend` Depth p’ = Depth (p `closer` p’)

The second method definition can be simplified nicely

  mappend = inDepth2 closer

where

  inDepth2 = unDepth ~> unDepth ~> Depth

using the ideas from Prettier functions for wrapping and wrapping and the notational improvement from Matt Hellige’s Pointless fun.

FRP — Future values

The Monoid instance for Depth may look familiar to you if you’ve been following along with my future values or have read the paper Simply efficient functional reactivity. A future value has a time and a value. Usually, the value cannot be known until its time arrives.

newtype FutureG t a = Future (Time t, a)
 
instance (Ord t, Bounded t) => Monoid (FutureG t a) where
  mempty = Future (maxBound, undefined)
  Future (s,a) `mappend` Future (t,b) =
    Future (s `min` t, if s <= t then a else b)

When we’re using a non-lazy (flat) representation of time, this mappend definition can be written more simply:

  mappend = minBy futTime
 
  futTime (Future (t,_)) = t

Equivalently,

  mappend = inFuture2 (minBy fst)

The Time type is really nothing special about time. It is just a synonym for the Max monoid, as needed for the Applicative and Monad instances.

This connection with future values means we can discard more code.

type RenderingD d = Image (FutureG d Color)
renderD :: (Ord d, Bounded d) => Geometry -> RenderingD d

Now we have our monoid (homo)morphism properties:

renderD mempty == mempty
 
renderD (ga `mappend` gb) == renderD ga `mappend` renderD gb

And we’ve eliminated the code for renderR by reusing and existing type (future values).

Future values?

What does it mean to think about depth/color pairs as being “future” colors? If we were to probe outward along a ray, say at the speed of light, we would bump into some number of 3D objects. The one we hit earliest is the nearest, so in this sense, mappend on futures (choosing the earlier one) is the right tool for the job.

I once read that a popular belief in the past was that vision (light) reaches outward to strike objects, as I’ve just described. I’ve forgotten where I read about that belief, though I think in a book about perspective, and I’d appreciate a pointer from someone else who might have a reference.

We moderns believe that light travels to us from the objects we see. What we see of nearby objects comes from the very recent past, while of further objects we see the more remote past. From this modern perspective, therefore, the connection I’ve made with future values is exactly backward. Now that I think about it in this way, of course it’s backward, because we see (slightly) into the past rather than the future.

Fixing this conceptual flaw is simple: define a type of “past values”. Give them exactly the same representation as future values, and deriving its class instances entirely.

newtype PastG t a = Past (FutureG t a)
  deriving (Monoid, Functor, Applicative, Monad)

Alternatively, choose a temporally neutral replacement for the name “future values”.

The bug in Z-buffering

The renderD function implements continuous, infinite Z-buffering, with mappend performing the z-compare and conditional overwrite. Z-buffering is the dominant algorithm used in real-time 3D graphics and is supported in hardware on even low-end graphics hardware (though not in its full continuous and infinite glory).

However, Z-buffering also has a serious bug: it is only correct for fully opaque colors. Consider a geometry g and a point p in the domain of the result image. There may be many different points in g that project to p. If g has only fully opaque colors, then at most one place on g contributes to the rendered image at p, and specifically, the nearest such point. If g is the union (mappend) of two other geometries, g == ga `union` gb, then the nearest contribution of g (for p) will be the nearer (mappend) of the nearest contributions of ga and of gb.

When colors may be partially opaque, the color of the rendering at a point p can depend on all of the points in the geometry that get projected to p. Correct rendering in the presence of partial opacity requires a fold that combines all of the colors that project onto a point, in order of distance, where the color-combining function (alpha-blending) is not commutative. Consider again g == ga `union` gb. The contributions of ga to p might be entirely closer than the contributions of gb, or entirely further, or interleaved. If interleaved, then the colors generated from each cannot be combined into a single color for further combination. To handle the general case, replace the single distance/color pair with an ordered collection of them:

type RenderingD d = Image [FutureG d Color]  – multiple projections, first try

Rendering a union (mappend) requires a merging of two lists of futures (distance/color pairs) into a single one.

More FRP — Events

Sadly, we’ve now lost our monoid morphism, because list mappend is (++), not the required merging. However, we can fix this problem as we did before, by introducing a new type.

Or, we can look for an existing type that matches our required semantics. There is just such a thing in the Reactive formulation of FRP, namely an event. We can simply use the FRP Event type:

type RenderingD d = Image (EventG d Color)
 
renderD :: (Ord d, Bounded d) => Geometry -> RenderingD d

Spatial transformation

Introducing depths allowed rendering to be defined compositionally with respect to geometric union. Is the depth model, enhanced with lists (events), sufficient for compositionality of rendering with respect to other Geometry operations as well? Let’s look at spatial transformation.

(*%)  :: Transform3 -> Geometry -> Geometry

Compositionally of rendering would mean that we can render xf *% g by rendering g and then using xf in some way to transform that rendering. In other words there would have to exist a function (*%%) such that

forall xf g. renderD (xf *% g) == xf *%% renderD g

I don’t know if the required (*%%) function exists, or what restrictions on Geometry or Transform3 it implies, or whether such a function could be useful in practice. Instead, let’s change the type of renderings again, so that rendering can accumulate transformations and apply them to surfaces.

type RenderingDX = Transform3 -> RenderingD
 
renderDX :: (Ord d, Bounded d) => Geometry -> RenderingDX d

with or without correct treatment of partial opacity (i.e., using futures or events).

This new function has a simple specification:

renderDX g xf == renderD (xf *% g)

from which it follows that

renderD g == renderDX g identityX

Rendering a transformed geometry then is a simple accumulation, justified as follows:

renderDX (xfi *% g)
 
  == {- specification of renderDX -}
 
\ xfo -> renderD (xfo *% (xfi *% g))
 
  == {- property of transformation -}
 
\ xfo -> renderD ((xfo `composeX` xfi) *% g)
 
  == {- specification of renderDX  -}
 
\ xfo -> renderDX g (xfo `composeX` xfi)

Render an empty geometry:

renderDX mempty
 
  == {- specification of renderDX -}
 
\ xf -> renderD (xf *% mempty)
 
  == {- property of (*%) and mempty -}
 
\ xf -> renderD mempty
 
  == {- renderD is a monoid morphism -}
 
\ xf -> mempty
 
  == {- definition of pure on functions -}
 
pure mempty
 
  == {- definition of mempty on functions -}
 
mempty

Render a geometric union:

renderDX (ga `mappend` gb)
 
  == {- specification of renderDX -}
 
\ xf -> renderD (xf *% (ga `mappend` gb))
 
  == {- property of transformation and union -}
 
\ xf -> renderD ((xf *% ga) `mappend` (xf *% gb))
 
  == {- renderD is a monoid morphism -}
 
\ xf -> renderD (xf *% ga) `mappend` renderD (xf *% gb)
 
  == {- specification of renderDX  -}
 
\ xf -> renderDX ga xf `mappend` renderDX gb xf
 
  == {- definition of liftA2/(<*>) on functions -}
 
liftA2 mappend (renderDX ga) (renderDX gb)
 
  == {- definition of mappend on functions -}
 
renderDX ga `mappend` renderDX gb

Hurray! renderDX is still a monoid morphism.

The two properties of transformation and union used above say together that (xf *%) is a monoid morphism for all transforms xf.

An earlier post introduced functional future values, which are values that cannot be known until the future, but can be manipulated in the present. That post presented a simple denotational semantics of future values simply as time/value pairs. With a little care in the definition of Time (using the Max monoid), the instances of Functor, Applicative, Monad are all derived automatically.

A follow-up post gave an implementation of Future values via multi threading. Unfortunately, that implementation did not necessarily satisfy the semantics, because it allowed the nondeterminism of thread scheduling to leak through. Although the implementation is usually correct, I wasn’t satisfied.

After a while, I hit upon an idea that really tickled me. My original simple semantics could indeed serve as a correct and workable implementation if I used a subtler form of time that could reveal partial information. Implementing this subtler form of time turned out to be quite tricky, and was my original motivation for the unamb operator described in the paper Simply efficient functional reactivity and the post Functional concurrency with unambiguous choice.

It took me several days of doodling, pacing outside, and talking to myself before the idea for unamb broke through. Like many of my favorite ideas, it’s simple and obvious in retrospect: to remove the ambiguity of nondeterministic choice (as in the amb operator), restrict its use to values that are equal when non-bottom. Whenever we have two different methods of answering the same question (or possibly failing), we can use unamb to try them both. Failures (errors or non-termination) are no problem in this context. A more powerful variation on unamb is the least upper bound operator lub, as described in Merging partial values.

I’ve been having trouble with the unamb implementation. When two (compatible) computations race, the loser gets killed so as to free up cycles that are no longer needed. My first few implementations, however, did not recursively terminate other threads spawned in service of abandoned computations (from nested use of unamb). I raised this problem in Smarter termination for thread racing, which suggested some better definitions. In the course of several helpful reader comments, some problems with my definitions were addressed, particularly in regard to blocking and unblocking exceptions. None of these definitions so far has done the trick reliably, and now it looks like there is a bug in the GHC run-time system. I hope the bug (if there is one) will be fixed soon, because I’m seeing more & more how unamb and lub can make functional programming even more modular (just as laziness does, as explained in Why Functional Programming Matters).

I started playing with future values and unambiguous choice as a way to implement Reactive, a library for functional reactive programming (FRP). (See Reactive values from the future and Simply efficient functional reactivity.) Over the last few days, I’ve given some thought to ways to implement future values that don’t need unambiguous choice. This post describes one such alternative.

Futures, presently

The current Future type is just a time and a value, wrapped in a a newtype:

newtype FutureG t a = Future (Time t, a)
  deriving (Functor, Applicative, Monad)

Where the Time type is defined via the Max monoid. The derived instances have exactly the intended meaning for futures, as explained in the post Future values and the paper Simply efficient functional reactivity. The “G” in the name FutureG refers to generalized over time.

Note that Future is parameterized over both time and value. Originally, I intended this definition as a denotational semantics of future values, but I realized that it could be a workable implementation with a lazy enough t. In particular, the times have to reveal lower bounds and allow comparisons before they’re fully known.

Warren Burton explored an applicable notion in the 1980s, which he called “improving values”, having a concurrent implementation but deterministic functional semantics. (See the paper Encapsulating nondeterminacy in an abstract data type with deterministic semantics or the paper Indeterminate behavior with determinate semantics in parallel programs. I haven’t found a freely-available online copy of either.) I adapted Warren’s idea and gave it an implementation via unamb.

Another operation finds the earlier of two futures. This operation has an identity and is associative, so I wrapped it up as a Monoid instance:

instance (Ord t, Bounded t) => Monoid (FutureG t a) where
  mempty = Future (maxBound, undefined)
  Future (s,a) `mappend` Future (t,b) =
    Future (s `min` t, if s <= t then a else b)

This mappend definition could be written more simply:

  u@(Future (t,_)) `mappend` u’@(Future (t’,_)) = if t <= t’ then u else u’

However, the less simple version has more potential for laziness. The time type might allow yielding partial information about a minimum before both of its arguments are fully known, which is the case with improving values.

Futures as functions

The Reactive library uses futures to define and implement reactivity, i.e., behaviors specified piecewise. Simplifying away the notion of events for now,

until :: BehaviorG t a -> FutureG t (BehaviorG t a) -> BehaviorG t a

The semantics (but not implementation) of BehaviorG is given by

at :: BehaviorG t a -> (t -> a)

The semantics of until:

(b `until` Future (t’,b’)) `at` t = b” `at` t
 where
   b” = if t <= t’ then b else b’

FRP (multi-occurrence) events are then built on top of future values, and reactivity on top of until.

The semantics of until shows what information we need from futures: given a time t, we need to know whether t is later than the future’s time and, if so, what the future’s value is. For other purposes, we’ll also want to know the future’s time, but again, only once we’re past that time. We might, therefore, represent futures as a function that gives exactly this information. I’ll call this function representation “function futures” and use the prefix “S” to distinguish the original “simple” futures from these function futures.

type TryFuture t a = Time t -> Maybe (S.FutureG t a)
 
tryFuture :: F.FutureG t a -> TryFuture t a

Given a probe time, tryFuture gives Nothing if the time is at or before the future’s time, or Just u otherwise, where u is the simple future.

We could represent F.FutureG simply as TryFuture:

type F.FutureG = TryFuture  – first try

But then we’d be stuck with the Functor and Applicative instances for functions instead of futures. Adding a newtype fixes that problem:

newtype FutureG t a = Future { unFuture :: FutureGT t a } – second try

With this representation we can easily construct and try out function futures:

future :: TryFuture t a -> FutureG t a
future = Future
 
tryFuture :: FutureG t a -> TryFuture t a
tryFuture = unFuture

I like to define helpers for working inside representations:

inFuture  :: (TryFuture t a -> TryFuture t’ a’)
          -> (FutureG   t a -> FutureG   t’ a’)
 
inFuture2 :: (TryFuture t a -> TryFuture t’ a’ -> TryFuture t” a”)
          -> (FutureG   t a -> FutureG   t’ a’ -> FutureG   t” a”)

The definitions of these helpers are very simple with the ideas from Prettier functions for wrapping and wrapping and a lovely notation from Matt Hellige’s Pointless fun.

inFuture  = unFuture ~> Future
 
inFuture2 = unFuture ~> inFuture 
 
(~>) :: (a’ -> a) -> (b -> b’) -> ((a -> b) -> (a’ -> b’))
g ~> h = result h . argument g

These helpers make for some easy definitions in the style of Semantic editor combinators:

instance Functor (FutureG t) where
  fmap = inFuture.fmap.fmap.fmap
 
instance (Bounded t, Ord t) => Applicative (FutureG t) where
  pure  = Future . pure.pure.pure
  (<*>) = (inFuture2.liftA2.liftA2) (<*>)

Type composition

These Functor and Applicative instances (for FutureG t) may look mysterious, but they have a common and inevitable form. Every type whose representation is the (semantic and representational) composition of three functors has this style of Functor instance, and similarly for Applicative.

Instead of repeating this common pattern, let’s make the type composition explicit, using Control.Compose from the TypeCompose library:

type FutureG t = (->) (Time t) :. Maybe :. S.FutureG t  – actual definition

Now we can throw out inFuture, inFuture2, (~>), and the Functor and Applicative instances. These instances follow from the general instances for type composition.

Monoid

The Monoid instance could also come automatically from type composition:

instance Monoid (g (f a)) => Monoid ((g :. f) a) where
  { mempty = O mempty; mappend = inO2 mappend }

The O here is just the newtype constructor for (:.), and the inO2 function is similar to inFuture2 above.

However, there is another often-useful Monoid instance:

– standard Monoid instance for Applicative applied to Monoid
instance (Applicative (g :. f), Monoid a) => Monoid ((g :. f) a) where
  { mempty = pure mempty; mappend = liftA2 mappend }

Because these two instances “overlap” are are both useful, neither one is declared in the general case. Instead, specialized instances are declared where needed, e.g.,

instance (Ord t, Bounded t) => Monoid (FutureG t a) where
  mempty  = (  O .  O ) mempty   – or future mempty
  mappend = (inO2.inO2) mappend

How does the Monoid instance work? Start with mempty. Expanding:

mempty
 
  == {- definition -} 
 
O (O mempty)
 
  == {- mempty on functions -}
 
O (O (const mempty))
 
  == {- mempty on Maybe -}
 
O (O (const Nothing))

So, given any probe time, the empty (never-occurring) future says that it does not occur before the probe time.

Next, mappend:

O (O f) `mappend` O (O f’)
 
  == {- mappend on FutureG -}
 
O (O (f `mappend` f’))
 
  == {- mappend on functions -}
 
O (O (\ t -> f t `mappend` f’ t))
 
  == {- mappend on Maybe -}
 
O (O (\ t -> f t `mappendMb` f’ t))
  where
    Nothing `mappendMb` mb’    = mb’
    mb `mappendMb` Nothing     = mb
    Just u `mappendMb` Just u’ = Just (u `mappend` u’)

The mappend in this last line is on simple futures, as defined above, examining the (now known) times and choosing the earlier future. Previously, I took special care in that mappend definition to enable min to produce information before knowing whether t <= t'. However, with this new approach to futures, I expect to use simple (flat) times, so it could instead be

u@(Future (s,_)) `mappend` u’@(Future (s’,_)) = if s <= s’ then u else u’

or

u `mappend` u’ = if futTime u <= futTime u’ then u else u’
 
futTime (Future (t,_)) = t

or

mappend = minBy futTime

How does mappend work on function futures? Given a test time t, if both futures are at least t, then the combined future is at least t (yielding Nothing). If either future is before t and the other isn’t, then the combined future is the same as the one before t. If both futures are before t, then the combined future is the earlier one.

Relating function futures and simple futures

The function-based representation of futures relates closely to the simple representation. Let’s make this relationship explcit by defining mappings between them:

sToF :: Ord t => S.FutureG t a -> F.FutureG t a
 
fToS :: Ord t => F.FutureG t a -> S.FutureG t a

The first one is easy:

sToF u@(S.Future (t, _)) =
  future (\ t’ -> if t’ <= t then Nothing else Just u)

The reverse mapping, fToS, is trickier and is only defined on the image (codomain) of sToF. I think it can be defined mathematically but not computationally. There are two cases: either the function always returns Nothing, or there is at least one t for which it returns a Just. If the former, then the simple future is mempty, which is S.Future (maxBound, undefined). If the latter, then there is only one such Just, and the simple future is the one in that Just. Together, (sToF, fToS) form a projection-embedding pair.

We won’t really have to implement or invoke these functions. Instead, they serve to further specify the type F.FutureG and the correctness of operations on it. The representation of F.FutureG as given allows many values that do not correspond to futures. To eliminate these representations, require an invariant that a function future must be the result of applying sToF to some simple future.

We’ll require that each operation preserves this invariant. However, let’s prove something stronger, namely that operations on on F.FutureG correspond precisely to the same operations on S.FutureG, via sToF. In other words, sToF preserves the shape of the operations on futures. For type classes, these correspondences are the type class morphisms. For instance, sToF is a Monoid morphism:

sToF mempty == mempty
 
sToF (u `mappend` u’) == sToF u `mappend` sToF u’

Caching futures

This function representation eliminates the need for tricky times (using improving values and unamb), but it loses the caching benefit that lazy functional programming affords to non-function representations. Now let’s reclaim that benefit. The trick is to exploit the restriction that every function future must be (semantically) the image of a simple future under sToF.

Examining the definition of sToF, we can deduce the following monotonicity properties of (legitimate) function futures:

• If the probe function yields Nothing for some t', then it yields Nothing for earlier times.
• If the probe function yields Just u for some t', then it yields Just u for all later times.

We can exploit these monotonicity properties by caching information as we learn it. Caching of this sort is what distinguishes call-by-need from call-by-name and allows lazy evaluation to work efficiently for data representations.

Specifically, let’s save a best-known lower bound for the future time and the simple future when known. Since the lower bound may get modified a few times, I’ll use a SampleVar (thread-safe rewritable variable). The simple future will be discovered only once, so I’ll use an IVar. I’ll keep the function-future for probing when the cached information is not sufficient to answer a query.

Prefix this caching version with a “C”, to distinguish it from function futures (”F”) and the simple futures (”S”):

data C.FutureG t a =
  Future (SampleVar t) (IVar (S.FutureG t a)) (F.FutureG t a)

Either the simple future or the function future will be useful, so we could replace the second two fields with a single one:

data C.FutureG t a =
  Future (SampleVar t) (MVar (Either (F.FutureG t a) (FF.FutureG t a)))

We’ll have to be careful about multiple independent discoveries of the same simple future, which would correspond to multiple writes IVar with the same value. (I imagine there are related mechanics in the GHC RTS for two threads evaluating the same thunk that would be helpful to understand.) I guess I could use a SampleVar and just not worry about multiple writes, since they’d be equivalent. For now, use the IVar version.

The caching representation relates to the function representation by means of two functions:

dToF :: Ord     t => C.FutureG t a -> F.FutureG t a
 
fToD :: Bounded t => F.FutureG t a -> C.FutureG t a

The implementation

dToF (C.Future tv uv uf) =
  F.Future $ \ t’ -> unsafePerformIO $
    do mb <- tryReadIVar uv
       case mb of
         j@(Just (S.Future (Max t,_))) ->
           return (if t’ <= t then Nothing else j)
         Nothing        ->
           do tlo <- readSampleVar tv
              if t’ <= tlo then
                 return Nothing
               else
                 do let mb’ = F.unFuture uf t’
                    writeIVarMaybe uv mb’
                    return mb’
 
– Perhaps write to an IVar
writeIVarMaybe :: IVar a -> Maybe a -> IO ()
writeIVarMaybe v = maybe (return ()) (writeIVar v)
 
fToD uf = unsafePerformIO $
          do tv <- newSampleVar t0
             uv <- newIVar
             writeIVarMaybe uv (F.unFuture uf t0)
             return (Future tv uv uf)
 where
   t0 = minBound

It’ll be handy to delegate operations to F.Future:

inF :: (Ord t, Bounded t’) =>
       (F.FutureG t a -> F.FutureG t’ a’)
    -> (  FutureG t a ->   FutureG t’ a’)
inF = dToF ~> fToD
 
inF2 :: (Ord t, Bounded t’, Ord t’, Bounded t”) =>
        (F.FutureG t a -> F.FutureG t’ a’ -> F.FutureG t” a”)
     -> (  FutureG t a ->   FutureG t’ a’ ->   FutureG t” a”)
inF2 = dToF ~> inF

Then

instance (Ord t, Bounded t) => Monoid (FutureG t a) where
  mempty  = fToD mempty
  mappend = inF2 mappend
 
instance (Ord t, Bounded t) => Functor     (FutureG t) where
  fmap = inF . fmap
 
instance (Ord t, Bounded t) => Applicative (FutureG t) where
  pure  = fToD . pure
  (<*>) = inF2 (<*>)

Wrap-up

Well, that’s the idea. I’ve gotten as far as type-checking the code in this post, but I haven’t yet tried running it.

What interests me most above is the use of unsafePerformIO here while preserving referential transparency, thanks to the invariant on F.FutureG (and the consequent monotonicity property). The heart of lazy evaluation of pure functional programs is just such an update, replacing a thunk with its weak head normal form (whnf). What general principles can we construct that allow us to use efficient, destructive updating and still have referential transparency? The important thing above seems to be the careful definition of an abstract interface such that the effect of state updates is semantically invisible through the interface.

I realized in the shower this morning that there’s a serious flaw in my unamb implementation as described in Functional concurrency with unambiguous choice. Here’s the code for racing two computations:

race :: IO a -> IO a -> IO a
a `race` b = do v  <- newEmptyMVar
                ta <- forkPut a v
                tb <- forkPut b v
                x  <- takeMVar  v
                killThread ta
                killThread tb
                return x
 
forkPut :: IO a -> MVar a -> IO ThreadId
forkPut act v = forkIO ((act >>= putMVar v) `catch` uhandler `catch` bhandler)
 where
   uhandler (ErrorCall "Prelude.undefined") = return ()
   uhandler err                             = throw err
   bhandler BlockedOnDeadMVar               = return ()

The problem is that each of the threads ta and tb may have spawned other threads, directly or indirectly. When I kill them, they don’t get a chance to kill their sub-threads. If the parent thread does get killed, it will most likely happen during the takeMVar.

My first thought was to use some form of garbage collection of threads, perhaps akin to Henry Baker’s paper The Incremental Garbage Collection of Processes. As with memory GC, dropping one consumer would sometimes result is cascading de-allocations. That cascade is missing from my implementation above.

Or maybe there’s a simple and dependable manual solution, enhancing the method above.

I posted a note asking for ideas, and got the following suggestion from Peter Verswyvelen:

I thought that killing a thread was basically done by throwing a ThreadKilled exception using throwTo. Can’t these exception be caught?

In C#/F# I usually use a similar technique: catch the exception that kills the thread, and perform cleanup.

Playing with Peter’s suggestion works out very nicely, as described in this post.

There is a function that takes a clean-up action to be executed even if the main computation is killed:

finally :: IO a -> IO b -> IO a

Using this function, the race definition becomes a little shorter and more descriptive:

a `race` b = do v  <- newEmptyMVar
                ta <- forkPut a v
                tb <- forkPut b v
                takeMVar v `finally`
                  (killThread ta >> killThread tb)

This code is vulnerable to being killed after the first forkPut and before the second one, which would then leave the first thread running. The following variation is a bit safer:

a `race` b = do v  <- newEmptyMVar
                ta <- forkPut a v
                (do tb <- forkPut b v
                    takeMVar v `finally` killThread tb)
                 `finally` killThread ta

Though I guess it’s still possible for the thread to get killed after the first fork and before the next statement begins. Also, this code difficult to write and read. The general pattern here is to fork a thread, do something else, and kill the thread. Give that pattern a name:

forking :: IO () -> IO b -> IO b
forking act k = do tid <- forkIO act
                   k `finally` killThread tid

The post-fork action in both cases is to execute another action (a or b) and put the result into the mvar v. Removing the forkIO from forkPut, leaves putCatch:

putCatch :: IO a -> MVar a -> IO ()
putCatch act v = (act >>= putMVar v) `catch` uhandler `catch` bhandler
 where
   uhandler (ErrorCall "Prelude.undefined") = return ()
   uhandler err                             = throw err
   bhandler BlockedOnDeadMVar               = return ()

Combe forking and putCatch for convenience:

forkingPut :: IO a -> MVar a -> IO b -> IO b
forkingPut act v k = forking (putCatch act v) k

Or, in the style of Semantic editor combinators,

forkingPut = (result.result) forking putCatch

Now the code is tidy and safe:

a `race` b = do v <- newEmptyMVar
                forkingPut a v $
                  forkingPut b v $
                    takeMVar v

Recall that there’s a very slim chance of the parent thread getting killed after spinning a child and before getting ready to kill the sub-thread (i.e., the finally). If this case happens, we will not get an incorrect result. Instead, an unnecessary thread will continue to run and write its result into an mvar that no one is reading.