TLDR: Here is a patch for GHC to dump STG in a form compatible with miniSTG.

MiniSTG

The Spineless Tagless G-machine (STG) is an abstract machine designed to run lazy functional languages. An abstract code for it, an STG language, is a minimal lazy functional language, GHC uses it as an intermediate representation for haskell code.

MiniSTG is an interpreter for STG language. It is a bit limited, only integral literals are supported, and very few primops are provided. But it is very useful if you want to study how haskell code is executed by GHC. The most interesting its feature is execution tracing.

To show few examples, lets define boxed integers:

zero = CON(Int 0);

one = CON(Int 1);

plus = FUN(x y -> case x of {
	Int i -> case y of {
		Int j -> case plus# i j of {
			k -> let {
				r = CON(Int k);
				} in r;
		}
	}
});

main = THUNK(plus one one);

Here Int is a constructor for boxed integers (you don’t have to define constructors upfront), zero and one define boxed literals. The next declaration is more interesting, plus is a function that takes two arguments. They are expected to be boxed integers, and case is used to unboxed them. Then built-in primop plus# performs the real work to add two unboxed integers. Finally the result is reboxed and returned. The last line defines an entry point for the program. The output:

$ ministg --noprelude -s EA main.stg
(Int 2)

Now lets define a list:

nil = CON(Nil);

con = FUN(x xs -> let {
	r = CON(List x xs)
	} in r
);

length = FUN(l -> case l of {
	Nil -> zero;
	List x xs -> let {
		n = THUNK(length xs);
		} in plus one n;
});

Here nil is an empty list, con prepends a value to a list, and length calculates length of a list using the plus function we already defined. Lets test it:

list1 = THUNK(con zero nil);
list2 = THUNK(con zero list1);
list3 = THUNK(con zero list2);
list4 = THUNK(con zero list3);

main = THUNK(length list4);

Output:

$ ministg --noprelude -s EA main.stg
(Int 4)

I hope you got the idea. There are few restrictions: the only way to allocate anything on heap is to use CON, FUN or THUNK inside let or on top level, so the next code is invalid because it tries to allocate a list cell outside of let (compare with the definition above):

con = FUN(x xs ->
	CON(List x xs)
);

Also all function arguments should be allocated on heap, you can’t pass a complex expression to a function. So the next code is invalid:

length = FUN(l -> case l of {
	Nil -> zero;
	List x xs -> plus one (length xs);
});

MiniSTG doesn’t support pattern matching on literals, so you have to use eq# and intToBool# primops to compare boxed integers:

eq = FUN(x y -> case x of {
	Int i -> case y of {
		Int j -> case eq# i j of {
			k -> intToBool# k
		};
	};
});

main = THUNK(eq one one);

Output:

$ ministg --noprelude -s EA main.stg
True

GHC

Writing in STG is fun, but how real haskell code looks when translated into STG? GHC has a -ddump-stg flag to dump it, but unfortunately it looks far from what miniSTG accepts:

f_rn0 :: GHC.Types.Int -> GHC.Types.Int
[GblId, Arity=1, Str=DmdType, Unf=OtherCon []] =
    sat-only \r [ds_s1Mn]
        case ds_s1Mn of wild_s1Mo {
          GHC.Types.I# ds1_s1Mp [Occ=Once!] ->
              case ds1_s1Mp of _ [Occ=Dead] {
                __DEFAULT ->
                    let {
                      sat_s1Ms [Occ=Once] :: GHC.Types.Int
                      [LclId, Str=DmdType] =
                          \u []
                              let {
                                sat_s1Mr [Occ=Once] :: GHC.Types.Int
                                [LclId, Str=DmdType] =
                                    \u [] GHC.Enum.pred GHC.Enum.$fEnumInt wild_s1Mo;
                              } in  f_rn0 sat_s1Mr;
                    } in  GHC.Num.* GHC.Num.$fNumInt wild_s1Mo sat_s1Ms;
                0# -> GHC.Types.I# [1#];
              };
        };

Even if I remove all irrelevant information, you will probably not recognize factorial function, but at least now it looks similar to miniSTG syntax:

f_rn0 = [ds_s1Mn]
        case ds_s1Mn of wild_s1Mo {
          GHC.Types.I# ds1_s1Mp ->
              case ds1_s1Mp of _ {
                __DEFAULT ->
                    let {
                      sat_s1Ms = []
                              let {
                                sat_s1Mr = []
                                    GHC.Enum.pred GHC.Enum.$fEnumInt wild_s1Mo;
                              } in  f_rn0 sat_s1Mr;
                    } in  GHC.Num.* GHC.Num.$fNumInt wild_s1Mo sat_s1Ms;
                0# -> GHC.Types.I# [1#];
              };
        };

The biggest difference, except pattern matching on unboxed literals, is case expression:

case a of b {
	__DEFAULT -> ...
	...
}

Here b is an alias for the result of a (note that a could be an expression), it corresponds to “as patter” in haskell. In miniSTG it can be represented as two nested cases:

case a of {
	b -> case b of {
		...
	}
}

Otherwise the conversion is trivial. The patch mentioned at the beginning tries to automatically convert GHC syntax to miniSTG one.

Using GHC and miniSTG together

First we need custom prelude that defines all basic declarations (Prelude.hs):

{-# LANGUAGE PackageImports #-}

module Prelude
( Int
, zero
, one
, plus
, sub
, mul
, eqInt
, Bool (..)
)
where

import "base" Prelude (Bool (..))

data Int = Int

{-# NOINLINE zero #-}
zero :: Int
zero = Int

{-# NOINLINE one #-}
one :: Int
one = Int

{-# NOINLINE plus #-}
plus :: Int -> Int -> Int
plus _ _ = Int

{-# NOINLINE sub #-}
sub :: Int -> Int -> Int
sub _ _ = Int

{-# NOINLINE mul #-}
mul :: Int -> Int -> Int
mul _ _ = Int

{-# NOINLINE eqInt #-}
eqInt :: Int -> Int -> Bool
eqInt _ _ = False

Note that implementation for the declarations is not important, we are going to implement them directly in miniSTG anyway. Now a test module (Test.hs):

module Test
(test
)
where

pred :: Int -> Int
pred n = n `sub` one

f :: Int -> Int
f n | n `eqInt` zero
    = one
    | True
    = n `mul` f (pred n)

two = plus one one
five = two `plus` two `plus` one

test :: Int
test = f five

If you compile this module with -ddump-ministg, you get the next:

f = FUN(n_sJm -> case eqIntz1Prelude n_sJm z0eroz1Prelude of {
	 wild_sJn -> case wild_sJn of {
	     Falsez1GHCz1Types -> let {
		  sat_sJp = THUNK(let {
			  sat_sJo = THUNK(subz1Prelude n_sJm onez1Prelude)
			  } in
			  f sat_sJo)
		  } in
		  mulz1Prelude n_sJm sat_sJp;
	     Truez1GHCz1Types -> let {
		 res_var_ = THUNK(onez1Prelude)
		 } in
		 res_var_;
	     };
	 });

two = THUNK(plusz1Prelude onez1Prelude onez1Prelude);

sat_sJr = THUNK(let {
                sat_sJq = THUNK(plusz1Prelude two two)
                } in
                plusz1Prelude sat_sJq onez1Prelude);

testz1Test = THUNK(f sat_sJr);

Names are encoded, e.g. Falsez1GHCz1Types is a False constructor from GHC.Types module. Lets add an entry point:

main = THUNK(testz1Test);

and run it:

$ ministg --noprelude -s EA test.stg
ministg: undefined variable: "eqIntz1Prelude"

Oops, we need to define prelude. Create Prelude.stg with the next content:

z0eroz1Prelude = CON(Int 0);
onez1Prelude = CON(Int 1);

plusz1Prelude = FUN(x y -> case x of {
	Int i -> case y of {
		Int j -> case plus# i j of {
			k -> let {
				r = CON(Int k)
				} in r;
		};
	};
});

subz1Prelude = FUN(x y -> case x of {
	Int i -> case y of {
		Int j -> case sub# i j of {
			k -> let {
				r = CON(Int k)
				} in r;
		};
	};
});

mulz1Prelude = FUN(x y -> case x of {
	Int i -> case y of {
		Int j -> case mult# i j of {
			k -> let {
				r = CON(Int k)
				} in r;
		};
	};
});

eqIntz1Prelude = FUN(x y -> case x of {
	Int i -> case y of {
		Int j -> case eq# i j of {
			k -> case intToBool# k of {
				True -> true;
				False -> false;
			};
		};
	};
});

true = CON(Truez1GHCz1Types);
false = CON(Falsez1GHCz1Types);

Note that here we converted built-in True and False to the corresponding constructors from GHC.Types. Now we can run the program (note that we removed --no-prelude flag):

$ ministg -s EA test.stg
(Int 120)

Yay! We have working frontend for miniSTG! Note that nothing stops us from using advanced haskell features like type classes because they are compiled out to simple constructs. For example, lets write the same factorial function using Eq type class:

class Eq a where
  eq :: a -> a -> Bool

instance Eq Int where
  eq = eqInt

f :: Int -> Int
f n | n `eq` zero
    = one
    | True
    = n `mul` f (pred n)

If you don’t yet know how type classes work in haskell, then you have a good chance to figure it out from STG dump!

More posts

Atom feed

It is hard to quantify over-engineering. But it is crucial for library API designer to identify over-engineering as early as possible, and keep API simple and easy to use.

Over-engineering is about unnecessary complexity. In theory it is easy to avoid: each time you see multiple alternatives and you are not sure which one is better, you should select the simplest one. It practice we don’t always can say what alternative is simpler. Often we even don’t see other alternative, so the decision is made without any complexity analyze.

It this post I’ll try to do a bit unusual thing. I’ll take a problem, and make the simples API design I can imaging. Then I’ll make a series of redesigns, successively increasing complexity, and we’ll discuss whether the complexity was necessary. You can decide yourself at which point the API becomes “over-engineered”.

The problem is question is a key/val database. The API we’ll start looks like the next:

data DB
open :: FilePath -> IO DB
close :: DB -> IO ()
set :: DB -> ByteString -> ByteString -> IO ()
get :: DB -> ByteString -> IO (Maybe ByteString)

It is so simple, that I’m even not going to describe what it is doing. One even don’t need to know anything about monads to use it (I assume that do-notation doesn’t count). Now lets start iterating on the API.

Boilerplate

The first thing we notice is that three functions accept DB as an argument. What is user uses this functions in a row, like this:

withDB :: FilePath -> (DB -> IO a) -> IO a
withDB path use = bracket (new path) close use

withDB "some.db" $ \db -> do
  set db "key1" "val1"
  set db "key2" "val2"
  ...
  set db "keyN" "valN"

It is a boilerplate! We can avoid it using Reader monad transformer:

set :: ByteString -> ByteString -> Reader DB IO ()
get :: ByteString -> Reader DB IO (Maybe ByteString)

Now user doesn’t have to pass DB explicitly:

withDB :: FilePath -> Reader DB IO a -> IO a
withDB path use = bracket (new path) close (runReader use)

withDB "some.db" $ do
  set "key1" "val1"
  set "key2" "val2"
  ...
  set "keyN" "valN"

Kind of cool. But also we increased complexity of the API. Now user has to know about monads, transformers, lifting, etc. Even worse, we introduce new abstraction, implicit environment, which is inadequate to out problem. Imaging that you want two databases at the same time. With the initial version of API it is trivial:

withDB "some1.db" $ \db1 -> do
  withDB "some2.db" $ \db2 -> do
    maybe_v1 <- get db1 "key1"
    set db2 "key1" (fromMaybe "" maybe_v1)

    maybe_v2 <- get db1 "key2"
    set db2 "key2" (fromMaybe "" maybe_v2)
    ...

With the new API we’ll need a bit of code golfing to do something like that. Does a bit of boilerplate worse the complexity? How will users use the API more often? As a library writers, we can’t know, so it is better to stick with simpler version, the initial one. A bit of boilerplate is far cheaper then wrong abstraction. But lets accept this additional complexity, and make the next step.

MTL

At the previous step we introduced another issue. What if user uses his own transformer stack? We can’t compose different transformer stacks, we can only nest them. Lets introduce mtl!

set :: (MonadReader DB m, MonadIO m) => ByteString -> ByteString -> m ()
get :: (MonadReader DB m, MonadIO m) => ByteString -> m (Maybe ByteString)

Now API user has to understand type classes and mtl. Type signature becomes longer. Seasoned haskellers will certainly not find it problematic, but they are able to solve the issue with transformer stacks! By contrast newcomers will probably not be able to use the API at all. Note that the original design we started with doesn’t suffer from the issue with transformer stacks composition, simply because it doesn’t use transformers. Is the complexity necessary here? I think it is not, but you can decide for yourself.

Structured data

It is rare to store plain strings in database. Usually we store some structured data, so we need a way to serialize and deserialize it. The standard way to handle serialization is to use type classes:

set :: (MonadReader DB m, MonadIO m, Serialize v) => ByteString -> v -> m ()
get :: (MonadReader DB m, MonadIO m, Serialize v) => ByteString -> m (Maybe v)

Looks good. Here I used Serialize type class from cereal package. Wait, but what if user uses binary package? What about the next:

set :: (MonadReader DB m, MonadIO m, Binary a) => ByteString -> a -> m ()
get :: (MonadReader DB m, MonadIO m, Binary a) => ByteString -> m (Maybe a)

Which one to use? Should we provide both variants? It will be really bad idea, because it will introduce incidental dependencies on cereal and/or binary. Should we introduce our own type class? Does it worse the complexity? No, it doesn’t. Serialization is not the core functionality for our library, so our users should not be forced to learn one more serialization API just to get a value from the database.

(A hint: key name sometimes is a structured data too, what about encoding and decoding it too just like we do for values?)

Effects

Suppose we want to count all operations we do on the database. It could be useful for example for performance monitoring. We can just count everything inside MVar and provide an API to access it:

getPerformanceCounters :: DB -> IO Counters

But we should keep effects under control! Lets use free monad to solve the issue:

data Op next
  = Set ByteString ByteString next
  | Get ByteString (Maybe ByteString -> next)
  deriving (Functor)

interpret :: Free Op a -> IO a

Ops, we just moved the core functionality of our library out to interpreter. Now the library does everything except writing to and reading from database. I hope it is obviously over-engineering, so I’ll stop right here.

Conclusion

So monad transformers, free monads, etc. are bad and should be avoided? No, they are cool and useful. But as any other tool, they have their own application areas. There is nothing wrong in tranformer stack, mtl or free monad used in implementation, but please think twice before exposing them to external API. And certainly there are legitimate use cases where you really need them in API. Design API thoughtfully and keep it simple.

More posts

Atom feed

Collaborative editors (or RTCE) are very popular this days. There are lots of open source and proprietary solutions. So I was not surprised when I got a request to build one.

But I was surprised that I can’t find exhaustive description of technologies used to implement RTCE. Probably the best source I found here, it describes the general idea and pitfalls of RCTE implementations based on operational transformation (OT). Unfortunately it can’t be used to implement custom RTCE immediately – the algorithm is not explicitly stated, and correctness of the solution is not clear. And the original paper contains substantially more complex algorithm.

While reading different materials about the topic, I noticed that the problem has pretty reach set of algebraic properties. Exploring them allowed me to formulate the algorithm and proof its correctness. I’ll try to document the results below. Probably the most important result is a set of properties which we should prove by equation reasoning or check automatically to ensure correctness.

Document operations

Suppose we have a document \(A\), and some operation \(a\) transforms it to other document \(B\):

\[ B = a(A) \]

For example, document could be a text, and operation can insert or delete few characters in it. There is an identity operation \(e\), it doesn’t change the document.

The operation \(a\) is tightly coupled with \(A\). We can’t apply it to \(B\) or any other document. E.g. if \(a\) deletes "world" from "hello world!", then it makes no sense to delete it from "hello !". But there can exist other operation \(b\), which operates on \(B\):

\[ C = b(B) \]

And we can apply them in a row:

\[ C = b(a(A)) \label{composition}\tag{1} \]

That forms a new operation \(c\), which is a composition of \(a\) and \(b\) (note the order in composition, compare with \((\ref{composition})\)):

\[ c = a b \\ C = c(A) \]

Two operations are equivalent if they transform equal documents into equal. Identity operation \(e\) has usual properties with respect to composition:

\[ e a = a \\ a e = a \]

To make sense composition should be associative:

\[ (ab)c = a(bc) = abc \label{associativity}\tag{2}\]

But it is not commutative in general case, so \(ab\) is not necessary equivalent to \(ba\). Also each operation has an inverse because we always can undo any change.

Example: text document

As an example, lets see how operations can be implemented for simple plain text document. There are two atomic edits, one to insert at given position some string, and other to delete starting from given position a number of characters:

data Edit
  = Insert Int Text
  | Delete Int Int
  deriving (Show)

Composite operation can be just an array or atomic edits

newtype Patch = Patch
  { edits :: Vector Edit
  }
  deriving (Show)

instance Monoid Patch where
  mempty = empty
  mappend = append

empty :: Patch
empty = Patch Vector.empty

singleton :: Edit -> Patch
singleton edit = Patch (Vector.singleton edit)

append :: Patch -> Patch -> Patch
append p1 p2 = Patch (edits p1 Vector.++ edits p2)

Associativity \((\ref{associativity})\) is obviously satisfied. Applying Edit and Patch to a document is trivial, so lets omit that.

Operational transformation

Suppose we have a document \(S\), and two clients at the same time apply some arbitrary operations:

\[ A = a(S) \\ B = b(S) \]

Now the documents diverged, and we need some other operations \(a^\prime\) and \(b^\prime\) to transform them into a consistent state \(S^\prime\):

\[ b^\prime(A) = a b^\prime(S) = S^\prime = b a^\prime(S) = b a^\prime(S) \]

They should satisfy the obvious property:

\[ a b^\prime = b a^\prime \label{commute}\tag{3}\]

It can be represented using the following diagram:

Lets assume that there is an operational transformation \(T\) that it produces \(a^\prime\) and \(b^\prime\) for each \(a\) and \(b\) such that \((\ref{commute})\) is satisfied:

\[ (a^\prime, b^\prime) = T(a, b) \label{OT}\tag{4}\]

It is important to keep in mind that \(T\) is not necessary symmetric, so \(T(a, b)\) is not necessary equivalent to \(T(b, a)\). We should be careful not to mess with arguments, and we will draw diagrams preserving the order – the first argument always on left.

Now we should check that operation composition doesn’t break \((\ref{commute})\) under operational transformation \(T\). Lets try a composite operation as the second argument of \(T\), see the following diagram.

(UPDATE I messed things up a bit in the following proof, see here. Basically, the proof make sense for the Edit and Patch in the example, but in general case \((\ref{5c})\) can’t be proven, we should require it instead.)

Here by definition

\[ (a^\prime, b^\prime) = T(a, b) \label{5a}\tag{5a} \] \[ (a^{\prime\prime}, c^\prime) = T(a^\prime, c) \label{5b}\tag{5b} \] \[ (a^{\prime\prime}, b^\prime c^\prime) = T(a, b c) \label{5c}\tag{5c} \]

From \((\ref{5a})\) follows \(a b^\prime = b a^\prime\). From \((\ref{5b})\) follows \(a^\prime c^\prime = c a^{\prime\prime}\). Then

\[ a b^\prime c^\prime = b a^\prime c^\prime = b c a^{\prime\prime} \]

That is exactly what \((\ref{commute})\) states for \((\ref{5c})\). The same way we can prove that for a composed operation as the first argument of \(T\).

By induction we can prof that \((\ref{commute})\) is satisfied for arbitrary complex operations. It is more important then it sounds – it allows us to define operations in terms of a small number of basic operations. We define operational transformation only for them, and get it for complex operations automatically.

Back to the example

Lets defined \(T\) for the plain text document example. For insert operations, we simply adjust insert position for one of them:

transform :: Edit -> Edit -> (Edit, Edit)
transform (Insert at1 t1) (Insert at2 t2) =
  if at1 > at2
    then (Insert (at1 + Text.length t2) t1, Insert at2 t2)
    else (Insert at1 t1, Insert (at2 + Text.length t1) t2)

The case with two delete operations is a bit more involved. If ranges doesn’t overlap, we adjust starting position, the same way as for insert operations. But if they overlap, we should be careful not to delete more then necessary.

transform (Delete from1 count1) (Delete from2 count2)
  | from2 >= from1 + count1
  = (Delete from1 count1, Delete (from2 - count1) count2)

  | from1 >= from2 + count2
  = (Delete (from1 - count2) count1, Delete from2 count2)

  | from1 >= from2 && from1 + count1 <= from2 + count2
  = (Delete from2 0, Delete from2 (count2 - count1))

  | from2 >= from1 && from2 + count2 <= from1 + count1
  = (Delete from1 (count1 - count2), Delete from1 0)

  | from1 >= from2
  = let d = from2 + count2 - from1
    in (Delete from2 (count1 - d), Delete from2 (count2 - d))

  | otherwise
  = let d = from1 + count1 - from2
    in (Delete from1 (count1 - d), Delete from1 (count2 - d))

The first two guards handle the case of not overlapping edits. The second two – when one covers another. The last two – partially overlapping edits. The mixed case, when we transform insert and delete operations, is analogous:

transform (Insert at t) (Delete from count)
  | at >= from && at < from + count
  = (Insert from Text.empty, Delete from (count + Text.length t))
  | at < from
  = (Insert at t, Delete (from + Text.length t) count)
  | otherwise
  = (Insert (at - count) t, Delete from count)

transform d@Delete{} i@Insert{} =
  Tuple.swap $ transform i d

Note that the implementation above is not the only possible one. For example I decided to preserve both edits in case of two inserts into the same position. Other implementations can e.g. prefer the first insert, or ignore both conflicting inserts.

Transforming composed operations follows the inductive logic of proving \((\ref{commute})\) for them:

transform :: Patch -> Patch -> (Patch, Patch)
transform (Patch a) b =
  let step (a', b') a1 =
        let (a1', b'') = transformEdit a1 b'
        in (append a' (singleton a1'), b'')
  in Vector.foldl' step (empty, b) a

transformEdit :: Edit -> Patch -> (Edit, Patch)
transformEdit a (Patch b) =
  let step (a', b') b1 =
        let (a'', b1') = Edit.transform a' b1
        in (a'', append b' (singleton b1'))
  in Vector.foldl' step (a, empty) b

Equation reasoning and QuickCheck can be used to prove properties we developed in previous section, but we omit that.

Algorithm

Now we are ready to describe the algorithm.

Server maintains a state, which is a tuple of 3 elements \((S, n, s)\): the current document state \(S\); an integral number to identify current revision; a sequence of operations \(s = [..., a, b, c]\) applied to the initial revision to get \(S\). Server receives from clients tuples of 2 elements, an operations \(p\) to apply and a number identifying a revision to apply the operation to.

Each time new tuple received from a client, server finds the corresponding revision \(R\) and transforms \(p\) over all the operations from \(R\) to \(S\):

\[ (b^\prime c^\prime, p^\prime) = T(b c, p) \]

Server broadcasts \(p^\prime\) to all clients (we assume order-preserving channel), applies it to \(S\), increments revision \(n\) and appends \(p^\prime\) to \(s\):

\[ (S, n, s) \Rightarrow (p^\prime(S), n + 1, (s, p^\prime)) \label{server}\tag{SERVER}\]

Client side is a bit more involved. Each client maintains a state, a tuple of 5 elements: the last known server document state \(S\), the last known server revision \(n\), the operation it is trying to push to server \(a\) (in-flight operations), a buffered operation \(b\), and current local document state \(C\). Both \(a\) and \(b\) could be (and initially are) identity operations \(e\). In-flight operation is operations we sent to server, but not got an acknowledgment. All the local operations before the acknowledgment are buffered in \(b\), then client tries to push \(b\).

More formally, when local change is received, it is applied to the local document \(C\) and combined with buffered operation \(b\):

\[ (S, n, a, b, C) \Rightarrow (S, n, a, b p, p(C)) \label{local}\tag{LOCAL}\]

When remote change \(p\) is received form server (it is the operation \(p^\prime\) broadcasted by \((\ref{server})\) rule), and \(p\) is not equivalent to \(a\), client applies it to \(S\) to get new server document state and increments \(n\). Then client transforms \(a\) and \(b\) and updates \(C\) according the following rule:

\[ (S, n, a, b, C) \Rightarrow (p(S), n + 1, a^\prime, b^\prime, p''(C)) \label{remote}\tag{REMOTE} \] where \[ (p^\prime, a^\prime) = T(p, a) \] \[ (p^{\prime\prime}, b^\prime) = T(p^\prime, b) \]

It will be more clear from the following diagram. Here \(S^\prime\) represents new server document state, and \(C^\prime\) represents new local document state.

We need two more state transition rules. When client receives remote change \(p\) which is equivalent to \(a\), then it means that server accepted our in-flight operation. We should simply discard \(a\) (replace it with identity operation \(e\)), apply \(p\) to server document state and increment revision:

\[ (S, n, a, b, C) \Rightarrow (p(S), n + 1, e, b, C) \label{ack}\tag{ACK}\] where \[ a = p \]

And finally client should push buffered operations to server. Whenever \(a\) is equivalent to identity but \(b\) is not, client sends a tuple of 2 elements, buffered operations \(b\) and last know server revision \(n\), to server, see \((\ref{server})\) rule. Client state transition rule:

\[ (S, n, a, b, C) \Rightarrow (S, n, b, e, C) \label{send}\tag{SEND} \] where \[ a = e \land b \ne e \]

Convergence

Lets now prove that server and client versions of the document will converge eventually. First of all we notice that the client’s algorithm is built to preserve the following property for each state:

\[ (S, n, a, b, C) \Rrightarrow C = ab(S) = b(a(S)) \label{invariant}\tag{6}\]

I.e. local document state is \(ab\) far from the last known server document state. Lets prove it for each client’s transition rule. After applying \((\ref{local})\) we obviously have

\[ abp(S) = p(ab(S)) = p(C) \]

Proved. After \((\ref{remote})\)

\[ p a^\prime b^\prime (S) = ap^\prime b^\prime (S) = a b p^{\prime\prime}(S) = p^{\prime\prime} (ab(S)) = p^{\prime\prime}C \]

(We used \((\ref{commute})\) here.) Proved. I’ll omit profs for \((\ref{ack})\) and \((\ref{send})\) – they are analogous.

If client receives operations from server in the same order it sends them, then his last known server document state obviously converges to server’s document state. Now it is enough to prove that \(a\) and \(b\) (in-flight and buffered operations) will become identity operations \(e\) eventually, and we prove convergence:

\[ C = ab(S) = ee(S) = S \]

From \((\ref{send})\) follows that \(b\) vanishes whenever \(a\) vanishes. And from \((\ref{ack})\) follows that \(a\) vanishes when \(a = p\) condition is met. It means that server should acknowledge client’s in-flight operations by equivalent one. Lets prove it is the case.

Lets client state after the last acknowledge is \((S, n, e, a, C)\). Server state at the same revision is \((S, n, s)\). Now client applies \((\ref{send})\) rule, sends a tuple \((a, n)\) to the server and jumps to \((S, n, a, e, C)\) state.

At the same time server receives operation from some other client. Server applies \((\ref{server})\) rule. Lets denote transformed operation as \(b\), then server broadcasts \(b\) and jumps to the next state:

\[ (b(S), n + 1, (s, b)) \]

Midtime the client applies (a number of) local operation \(c\), according to \((\ref{local})\), it performs the next transition:

\[ (S, n, a, e, C) \Rightarrow (S, n, a, c, c(C))\]

Then client receives \(b\) from server and applies \((\ref{remote})\):

\[ (S, n, a, c, c(C)) \Rightarrow (b(S), n + 1, a^\prime, c^\prime, b^{\prime\prime}(C)) \] where \[ (b^\prime, a^\prime) = T(b, a) \] \[ (b^{\prime\prime}, a^\prime) = T(b^\prime, c) \]

At the same time server receives (\(a\), n) from client, applies \((\ref{server})\) and broadcasts \(a^\prime\):

\[ (b(S), n + 1, (s, b)) \Rightarrow (ba^\prime(S), n + 2, (s, b, a^\prime)) \] where \[ (b^\prime, a^\prime) = T(b, a) \] \[ (b^{\prime\prime}, a^\prime) = T(b^\prime, c) \]

Note that “where” clause in the last step on server exactly identical to the last step performed on client. It means that the operation broadcasted by server is equivalent to the in-flight operational on client. Client receives it and applies \((\ref{ack})\):

\[ (b(S), n + 1, a^\prime, c^\prime, b^{\prime\prime}(C)) \Rightarrow (ba^\prime(S), n + 2, e, c^\prime, b^{\prime\prime}a^\prime(C)) \]

Now client is ready to push the next operation. When all local operations are pushed and all remote operations are received, client state is \((S^\prime, n^\prime, e, e, C^\prime)\), where \(S^\prime = C^\prime\). We just proved convergence.

Demo implementation

You can find demo client and server on github. If you are interested in ready-to-use demo, then checkout cli to server and gtk ui for client Just start server and a number of clients and start typing. (Client requires theaded runtime)

The operation representation as an array of basic edits is simple. But it is hard to compare operations – two equivalent ones could be represented differently. That is why the demo compare operations by applying them to a document and comparing results. More sophisticated representation usually comes with a some kind of normalized form. See for example how it is implemented in ot package.

More posts

Atom feed

I’m not an active IDE user. This days I use XCode sometimes, because writing Objective-C without an IDE is a pain. Otherwise I use vim without any plugins.

But I always was interested in IDE internals. Many years ago I was working on Visual Studio debugger plugin for some proprietary RTOS, and I was impressed how huge and complex Visual Studio was. One person can’t create anything comparable. But that doesn’t mean we should not try :)

So I finally found time to experiment with some IDE features. In this post I’ll describe the roadmap and present the first phase – incremental lexer.

What I would like to achieve

The most basic IDE features are syntax highlighting, navigation, autocompletion and refactoring. To be usefull IDE should be interactive – we expect instant response to our actions. That is the most interesting aspect for me. So the feature list I’d like to experiment with:

• incremental lexing
• source highlighting
• incremental parsing
• navigation
• incremental typechecking
• type directed autocompletion

The goal is to make these work in soft real time, without blocking UI. For example, if we can’t hightlight code after an edit quickly enough, then lets show raw text and highlight it in backgroud. If we can’t show all possible autocompletions, then lets show only available ones and add more later. Basically all foreground operations should have complexity not worse then \(O(\log n)\) whatever \(n\) is.

Raw performance and memory usage are not the direct goals. Building full featured IDE is not the goal too.

Incremental lexing

Incremental lexer should maintain a list of tokens while user is editing the code. Ideally it should reuse already processed tokens.

It is not so hard, for example yi caches intermediate lexer states. On modification we just find the last valid point and restart from it.

But that way on each modification we have to process all the code from the modification to the end of the file. It is OK for highlighting though, because we can analyze the code only as far as it is necessary to hightlight visible part of the file. But we want to use results of lexing to build syntax tree incrementally, and nodes of the tree can be annotated with results of incremental type checking. We don’t want to lose all the work on each keystroke.

The solution is obvious – lets analyze code only until the next valid point. Basically, we stop when:

• we are outsize the affected area, and
• the current token parsed is equal to the cached one at this point, and
• the lexer state is equal to the cached one at this point

Conventions

(You can skip the details.)

More formally, we have a tokinizer

tokenize :: State -> String -> Result

data Result
  = Partial (String -> Result Token)  -- continuation
  | Done Token State Int Int          -- token, lexer state,
                                      -- length of input consumed
                                      -- and lookahead

It never fails, instead it returns some special token representing lexical error.

Lexer maintains the current source code as a list of characters

\[C = [c_0, c_1, ..., c_n]\]

and list of lexemes

\[L = [L_0, L_1, ..., L_n]\]

where

• \(L_i = (t_i, s_i, l_i, a_i)\)
• \(t_i\) is a token,
• \(s_i\) – lexer state after reading the token,
• \(l_i\) – number of characters consumed by lexer to produce the token, and
• \(a_i\) – lookahead, number of characters lexer examined without consuming.

The following invariant should be reserved:

\[\sum_{k=0}^{n}l_i = length(C) \label{invariant}\tag{1}\]

Single edit of the source code can be represented as a tuple

\[(p_s, p_e, C')\]

where

• \([p_s, p_e)\) – interval in \(C\) to delete
• \(C'\) – list of characters to insert.

For example, deleting 5 characters starting from position 3 will look like

\[(3, 8, \emptyset)\]

where \(\emptyset\) – empty list.

Inserting string “hello” at position 3 will look like

\[(3, 3, hello)\]

Dirty region

After each edit, lexer should invalidate part of the lexeme list \(L\) by replacing lexemes from \(L_i\) to \(L_j\) with special \(D\) token representing dirty region:

\[ [L_0, ...,L_{i-1}, (D, \_, l, 0), L_{j+1},..., L_n] \]

where

\[l = \sum_{k=i}^{j}l_k - (p_e-p_s) + length(C')\]

is a length of the dirty area, lookahead is zero and lexer state is irrelevant. Note that the invariant \((\ref{invariant})\) is satisfied.

Finding \(L_j\) is straightforward, it should be the first lexeme, such that

\[\sum_{k=0}^{j-1}l_k > p_e\]

Finding \(L_i\) is a bit harder. Obviously it should satisfy

\[\sum_{k=0}^{i-1}l_k < p_s\]

but it doesn’t take lookahead into account. Lexema \(L_k\) should be invalidated whenever the edit affects any of \(a_k\) characters after it.

Lets introduce a function to calculate lookahead of two subsequent lexemes

\[lookahead(L_k,L_{k+1}) = max (a_{k+1}, a_k-l_{k+1}) \label{lookahead}\tag{2}\]

It can be easily generalized to any number of lexemes. Now the beginning of the dirty region should satisfy

\[\sum_{k=0}^{i-1}l_k + lookahead(L_0,...,L_{i-1}) < p_s\]

Lexing

Now it is time to do actuall lexing of dirty region. Lets length of \(C\) before the dirty region is \(p\)

\[p = length (L_0, L_1, ..., L_{i-1}) = \sum_{k=0}^{i-1}l_k\]

Lets feed tokinizer with the last valid state and the input

\[ Done(t', s', l', a') = tokenize(s_{i-1}, [c_{p+1},c_{p+2},...])\]

(If the tokenizer returns Partial, we should feed more input. Lets assume it always returns Done.)

Now we can insert new lexeme into \(L\). If \(l' < l\), then

\[ [L_0, ...,L_{i-1}, (t', s', l', a'), (D, \_, l-l', 0), L_{j+1},..., L_n] \]

If \(l' > l\), then \(L_{j+1}\) (and probably few more lexemes) is invalid too

\[ [L_0, ...,L_{i-1}, (t', s', l', a'), (D, \_, l+l_{j+1}-l', 0), L_{j+2},..., L_n] \]

The \(l'=l\) case is more interesting. We should chech whether we are done, so lets run tokenizer one time more

\[ Done(t'', s'', l'', a'') = tokenize(s', [c_{p+l'+1},c_{p+l'+2},...])\]

If \((t'' = t_{j+1}) \land (s'' = s_{j+1})\), then we are done

\[ [L_0, ...,L_{i-1}, (t', s', l', a'), L_{j+1},..., L_n] \]

otherwise the next lexeme is still invalid

\[ [L_0, ...,L_{i-1}, (t', s', l', a'), (t'', s'', l'', a''), (D, \_, l+l_{j+1}-l'-l'', 0), L_{j+2},..., L_n] \]

In reallity we stop after a limited number of steps to ensure user gets instant feedback. E.g. when large chunk of code pasted into editor, only the initial part of it is visible, and we can hightlight it before the whole chunk is processed, and then continue processing the rest.

Complexity of operations

In theory everything is good. But it practice, we have a number of operations with \(O(n)\) complexity:

• to find \(L_i\) and \(L_j\) we have to traverse the entire \(L\) list
• to find the first dirty region, we have to traverse \(L\) too
• to update \(C\) and to build an input \([c_{p+1},...]\) for tokenizer, we have to traverse \(C\) list

That it not acceptable for real time UI.

The solution for the last issue is when know – it is a Rope. Basically it is a tree with small substrings of the whole string as a leafs. Each intermedite note is annotated with a length of a substring, represented by the subtrees, so insert, delete and split operations can be implemented with \(O(\log n)\) complexity.

Rope can be generalized to arbitrary list with some monoid as an annotation. In our case, we can represent \(L\) as a fingertree with the next monoid:

data Size = Size
  { chars :: !Int
  , lookAhead :: !Int
  , dirty :: !Bool
  }
  deriving (Eq, Show)

instance Monoid Size where
  mempty = Size 0 0 False
  mappend (Size chars1 lookAhead1 dirty1)
          (Size chars2 lookAhead2 dirty2)
    = Size chars lookAhead dirty
    where
    chars = chars1 + chars2
    lookAhead = max lookAhead2 (lookAhead1 - chars2)
    dirty = dirty1 || dirty2

Here chars represents \(l_k\), lookahead – \(a_k\) (compare with \((\ref{lookahead})\)), and dirty is True for \(D\) and False otherwise.

That way we can implement all mentioned operations with \(O(\log n)\) complexity.

Implementation

You can find the implementation on github.

• TextBuffer.hs contains implementation of \(C\),
• TokenBuffer.hs contains implementation of \(L\),
• Lex.hs implements the main lexer logic, and
• HaskellLex.hs is a simplified tokinizer for haskell.

The is also a UI based on gtk3 with syntax highlighting implemented using the incremental lexer. It is fully asynchronous, so you can edit file while it is processed in background. It also logs to the console the region processed on each step.

A short video.

Screenshot:

Final notes

It is important to make sure tokenizer consumes limited number of characters on each run. For example, multiline comments can be pretty long, but we want to provide user with instant feedback. To achieve that, we can split comment token into parts. That is the reason we have tokenizer state in the first place.

Other issue is not solved yet. Each time user enters {- into the buffer, all the rest of the file becomes a comment until user enters the closing -}. It probably requires special handling to prevent unnecessary reprocessing.

More posts

Atom feed

One of the most important Haskell features for me is a clear separation of pure and impure code. I can say whether a function can have side effects only by looking to its type. For example, print can perform arbitrary side effect, while (++) can’t perform any:

print :: Show a => a -> IO ()
(++) :: [a] -> [a] -> [a]

Restricted side effects

But sometimes such the binary separation (pure vs impure) is not enough, we may need fine grained control on what side effects a function may perform. Lets quote RWH

The blessing and curse of the IO monad is that it is extremely powerful. If we believe that careful use of types helps us to avoid programming mistakes, then the IO monad should be a great source of unease. Because the IO monad imposes no restrictions on what we can do, it leaves us vulnerable to all kinds of accidents.

How can we tame its power? Let’s say that we would like to guarantee to ourselves that a piece of code can read and write files on the local filesystem, but that it will not access the network. We can’t use the plain IO monad, because it won’t restrict us.

And Haskell provides us with tools to restrict side effects to a known set. For example, we can define custom type class, that restricts effects to HTTP operations (we are ignoring some details, like error handling etc.):

class Monad m => MonadHttp m where
  get :: Url -> m ByteString
  post :: Url -> ByteString -> m ByteString

Lets suppose we want to fetch weather information. It can look like the next:

fetchWeather :: MonadHttp m => m Weather
fetchWeather =
  parseWeather <$> get "http://example.com/weather.json"

Note that MonadHttp doesn’t have MonadIO instance, so fetchWeather can’t perform any side effects except HTTP request. So far so good.

But later we decide to cache weather information in file. How can we do that? Lets define another type class for filesystem operations:

class Monad m => MonadFS m where
  readFile :: FilePath -> m (Maybe ByteString)
  writeFile :: FilePath -> ByteString -> m ()

Then fetchWeather function will try to read weather information from a file, and perform HTTP request only if the file doesn’t exists:

fetchWeather :: (MonadHttp m, MonadFS m) => m Weather
fetchWeather = do
  json <- do
    cached <- readFile "cache.json"
    case cached of
      Just json -> return json
      Nothing -> do
        json <- get "http://example.com/weather.json"
        writeFile "cache.json" json
        return json
  return (parseWeather json)

Note that the function can perform two types of side effects: make HTTP requests and access filesystem, and it is clearly reflected by its type. Excellent!

Encapsulation

But lets look from point of view of function’s users. After introducing the cache, they have to update their code to introduce new type constraint, MonadFS. That is not a big deal when we control all the client code, but what if we have a lot of downstream dependencies? People will be angry because we broke their code.

The main question is why our users even noticed the change? Introducing cache should be transparent for them because it is actually an implementation detail. People just want to get weather forecast, they don’t want to care where we get weather information from. Implementation details should be encapsulated, but fetchWeather leaks them via type classes for restricted effects.

The best way to encapsulate effects is not to restrict them. We should provide users with fetchWeather function that works in unrestricted IO monad:

fetchWeatherIO :: IO Weather

That way we are free to change its implementation and introduce other side effects without affecting users, e.g. we may cache weather information in database or global mutable variable.

Interface vs implementation

But that doesn’t mean that restricting side effects always is bad. It is just a tool, that can be useful sometimes, but it is not a silver bullet. Most of the time it should not be used in public interface, but it is good to have in implementation. The point of the article is that we should be careful when exposing side effects to users unless it is desired.

On exceptions

It is interesting that the same arguments could be applied to exceptions vs ExceptT discussion (see here). A list of all exceptions function may throw (or a list of failures in error sum type) is actually an implementation detail. That sound counterintuitive, but we don’t actually need to handle all exceptional cases, so we don’t need a gigant sum type for them.

More posts

Atom feed

As you probably don’t know, I’m working on a PDF processing library in Haskell, pdf-toolbox. It can parse PDF files, generate them, it supports encrypted files, it can do incremental updates, extract text, blah-blah-blah. If you are interested, let me outline the current state and my future plans.

New release

I just released new versions for all packages that belong to the library: core , document , content and viewer.

The main change: pdf-toolbox-document now supports encryption handler version 4, so it can handle files encrypted with AES algorithm. Also few bugs were fixed in core and content. As you can see, nothing terribly exciting, and the blog post is not about the release actually.

Current state of the HEAD

At the end of 2014 I started API rewrite. I mostly finished with the initial goals, though more work is necessary to fix viewer and examples to compile again. But when doing the rewrite I fount that the API is still far from ideal. Well, it is bad. That is why I decided to port the latest changes to stable branch and release it, and then continue working on API redesign.

Broken API

I’m still not 100% sure what to do, and I’d like to know your opinion. Here the current plan.

PDF types

The design of PDF types is terrible. Newtype over bool?!! Yes, it was me who wrote that, but I did it more then 3 years ago, and I have no idea why I did that:

data Object a =
  ONumber Number |
  OBoolean Boolean |
  OName Name |
  ODict Dict |
  OArray Array |
  OStr Str |
  OStream (Stream a) |
  ORef Ref |
  ONull
  deriving (Eq, Show)

newtype Boolean = Boolean Bool
  deriving (Eq, Show)

newtype Dict = Dict [(Name, Object ())]
  deriving (Eq, Show)

-- and so on...

I’m going to remove most (all?) of the newtypes and introduce HashMap and Vector instead of lists.

Also, right now Stream type has a payload. It could be an actual stream content, or just an offset of the content, or anything else. Sometimes it is convenient, but now I think that it was bad idea. I’m going to remove the payload completely and pass it separately when necessary.

Probably something like that:

data Object =
  Number Scientific |
  Bool Bool |
  Name Text |
  Dict (HashMap Text Object) |
  Array (Vector Object) |
  String Text |
  Stream (HashMap Text Object) |
  Ref (Int, Int) |
  Null
  deriving (Eq, Show)

Also a better way to convert PDF values to domain types is necessary. Probably something like a Parser, that is used in FromJSON type class in aeson?

Error handling

The stable version uses EitherT to handle errors. I believe that it was wrong design decision. I switched to extensible exceptions in HEAD already. It still requires cleanup, e.g. I want to introduce more specific exceptions, but it is already much better in my opinion.

Custom monad transformer

I have Pdf monad transformer in stable version. I even have a type class for PDF operations. That is probably the worst thing one may do for PDF library. Just imaging that you want to operate on two PDF files at the same time. With custom monad it becomes a pain, and the easiest solution is probably to fork a separate thread for each PDF file.

In HEAD I already switched to IO, now all objects are passed explicitly as values. I like it :)

Side note: I like that a lot of libraries on Hackage switched to extensible exceptions and replaced custom monads with IO in API. E.g. websockets and mongoDB packages.

Reading encrypted documents

The current design is an example of unsafe API. You should check that the document is encrypted and then set user password , see here. The problem occurs when you forgot to do that – you get strange errors somewhere else, e.g. when extracting text.

I can add a special check to each operation and throw DocumentEncrypted exception when user forgot to set a password. But that will slowdown everything. And I can’t require password before opening the document because user should be able to examine parts of the document (encryption dictionary) to decide what password to use. I’m still looking for better solution.

Abstractions and tests

PDF is very big and complex. It is hard to come with solid abstractions because you can’t keep everything in your mind. A month ago I was sure I have excellent separation between PDF as a file format; as a collection of values; and as a document with title, pages etc. But one day my naive mental picture was ruined because of interconnections I was not aware about.

What can I do with that? Rearrange abstractions? Drop them? I don’t want to decide upfront, I’m going to be more agile instead. And refactoring will become the most important tool, but I need more tests for that. So test coverage becomes an important goal for me.

Conclusion

I wrote the first version of PDF parser more then 3 years ago. It was a dirty prototype, but it did the work – it was a tool to examine PDF file internal structure. Now it is a library with a lot of features and long history. It is not a prototype anymore, but it is dirty still :)

I don’t know how many users the library has. I get bug reports and feature requests periodically, but the only direct user is hoodle-publish package. As I described above, I’m going to completely change the API, and I’d like to know your opinion if you are using, going to use or even not going to use it.

More posts

Atom feed

This post is highly opinionated. It is about Haskell not having good namespace story. I’ll try to describe my point of view to this issue.

T? M? BS?

What do this letters mean for you? Most likely they are Data.Text, Data.Map and Data.ByteString. It is common to import this modules qualified and introduce short aliases:

import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import qualified Data.Text as T

foo = BS.length . BSL.toStrict . BSL.fromChunks . map T.encodeUtf8

It probably works for well known modules, but too often you can see LM, I, LT, ST and so on. That becomes a tradition to use short names. But is it a good tradition?

Short names make perfect sense in polymorphic code:

catMaybes :: [Maybe a] -> [a]
catMaybes ls = [x | Just x <- ls]

Here a and x can mean anything, so descriptive names will be misleading.

But it is not the case for module names. Short names here are confusing because there is no common scheme, T can be used for Data.Text of Data.Traversable. Is it so hard to type few letters?

import qualified Data.ByteString as ByteString
-- Yes, you can have a dot in module name alias:
import qualified Data.ByteString.Lazy as Lazy.ByteString
import qualified Data.Text as Text

foo = ByteString.length
    . Lazy.ByteString.toStrict
    . Lazy.ByteString.fromChunks
    . map Text.encodeUtf8

It is definitely longer and a bit noisy, but at least it is unambiguous.

But it becomes a real pain, regardless of short vs long alias, when we have long declaration (or a set of declarations) that use a lot of functions from the same qualified module:

import qualified Data.ByteString as ByteString

foo = ByteString.length
    . ByteString.append "!"
    . ByteString.drop 5
    . ByteString.take 10
    . ByteString.pack

Probably the best thing to do here is to refactor the declaration out to a separate module and import Data.ByteString unqualified. But it would be cool to be able to open particular module locally:

import qualified Data.ByteString as ByteString

foo = length
    . append "!"
    . drop 5
    . take 10
    . pack
  where
  ByteString{..} = import ByteString

somethingName, somethingEmail, somethingAge

Another common tradition is to prefix each record name or function with a prefix to be able to use them unqualified:

data Something = Something
  { somethingName :: Text
  , somethingEmail :: Email
  , somethingAge :: Int
  }

foo :: Something -> Text
foo something = "name:" <> somethingName something

Such a prefix is a poor mans namespace. Unfortunately in Haskell to create named namespace, we have to create a module:

module Something where

data Something = Something
  { name :: Text
  , email :: Email
  , age :: Int
  }

module Foo where

import Something (Something)
import qualified Something

foo :: Something -> Text
foo something = "name:" <> Something.name something

It is definitely better IMO. But it would be cool if datatype declaration will introduce a namespace, so that we don’t have to create a module:

data Something = Something
  { qualified name :: Text
  , qualified email :: Email
  , qualified age :: Int
  }

foo :: Something -> Text
foo something = "name:" <> Something.name something

The syntax is terrible, I know. Probably there should be better syntax, ideally we should be able to declare free functions withing the data type namespace:

data Person = Person
  { firstName :: Text
  , lastName :: Text
  }

  -- Note identation
  fullName :: Person -> Text
  fullName person = firstName person <> " " <> lastName person

foo person = "full name:" <> Person.fullName person

See also nested modules

Type-directed name resolution, overloaded record fields, etc

I believe that code should be as unambiguous as it is possible. Adhoc polymorphism makes code ambiguous – you can’t anymore say what function is called only looking to it’s usage side. Some recently proposed extensions has their own value (e.g. I like anonymous records), but I believe that namespaces support in Haskell should be improved, because namespaces is the right solution for the described issues.

More posts

Atom feed

TL;DR You should always free memory with the same allocator that allocated it for you.

We’ll discuss two different sets of malloc and free functions. The first one is defined in Foreign.Marshal.Alloc, and the second one is part of C runtime. To distinguish them, I’ll use H-malloc and H-free names for Haskell functions, and C-malloc and C-free for C functions.

Actually H-malloc and H-free just call their C counterparts, so usually the same allocator is used in all this 4 functions. But that doesn’t mean that we can mix them. The documentation is clear:

-- |Free a block of memory that was allocated with 'malloc',
-- 'mallocBytes', 'realloc', 'reallocBytes', 'Foreign.Marshal.Utils.new'
-- or any of the @new@/X/ functions in "Foreign.Marshal.Array" or
-- "Foreign.C.String".
--
free :: Ptr a -> IO ()
free  = _free

Note that it enumerates all the cases when H-free can be used, and C-malloc is not listed here. There are two reasons for that. First of all, the implementation may be changed to use some other allocator.

(You can skip this paragraph, it contains some low level details.) The second reason is that sometimes your program happens to be linked with multiple versions of C runtime. That sounds strange, but it is a very real situation. For example, your program may load external plugin statically linked with C runtime other then yours. As a result you have three sets of malloc/free functions: one from Haskell, another from your C runtime, and one more from the plugin’s C runtime. The last two are probably incompatible, and you’ll get random failures if you are not careful enough.

The usual rule to avoid any issue with allocator is: you should deallocate memory in the same module where you allocated it. E.g. if you allocated memory in Haskell, then please free it in Haskell. If you allocated memory in C library, then please deallocate it in the same C library. (The same goes for dynamically loaded plugins.)

The reason I wrote about it? There is an issue on ghc bug tracker about replacing the allocator used in H-malloc. And I decided to check how often code on github relies on the current behavior (e.g. uses H-free to deallocate memory, that was allocated by C-malloc). I was surprised how common it is. Even RWH recommends wrong approach:

-- file: ch17/PCRE-compile.hs
compile :: ByteString -> [PCREOption] -> Either String Regex
compile str flags = unsafePerformIO $
  useAsCString str $ \pattern -> do
    alloca $ \errptr       -> do
    alloca $ \erroffset    -> do
        pcre_ptr <- c_pcre_compile pattern (combineOptions flags) errptr erroffset nullPtr
        if pcre_ptr == nullPtr
            then do
                err <- peekCString =<< peek errptr
                return (Left err)
            else do
                reg <- newForeignPtr finalizerFree pcre_ptr -- release with free()
                return (Right (Regex reg str))

Here the pcre_ptr is allocated somewhere in pcre C library (probably using C-malloc), and deallocated using H-free (via finalizerFree). This code works most of the time, but it is wrong. The correct approach would be to call C function to deallocate memory. Some C libraries provide a special function that guarantees to call the correct deallocator. In case of pcre it seems to be pcre_free, and it should be used here instead of H-free.

More posts

Atom feed

What is wrong with CPP

CPP is a C preprocessor, but it is common to use it in Haskell. That leads to a number of issues.

• It can mess with haskell code.

CPP doesn’t understand Haskell code, instead it assumes C code. It is free to remove insignificant (for C, not for Haskell) whitespace, expand macros in Haskell comments and strings or mess with identifiers that contain ' or #.

• It leads to unnecessary recompilation.

Every time you change your .cabal file, e.g. add new module, or update dependencies, cabal regenerates cabal-macros.h file. Then the recompilation checker pessimistically decides to recompile all modules with CPP enabled.

• It makes automatic code analyzing and transforming harder.

If you use hlint or HaRe, then you probably know what I mean.

• When abused, it makes code harder to read.

It is not rare to see code intercalated with ifdefs that specify different behaviour for different platforms of library versions. Sometimes that is unavoidable though.

Most of the time CPP can be avoided or minimized. The most important tool here is abstraction.

Abstract over specific details

It is not Haskell specific, abstracting is widely used to minimize CPP in C. When you need different behaviour based on the current platform or the version of some dependencies, try to abstract over the difference instead of inlining platform specific code.

At the first glance it may look impossible to do. In such cased I usually simply duplicate code and then refactor it to reduce duplication.

Some times it is convenient to start with an umbrella module that provides a unified interface for the rest of program, and a number of platform specific implementations. Note: you don’t need CPP to select a specific module, cabal lets you conditionally include modules based on the platform or other conditions.

Example: fsnotify

An excellent example of such an approach is the fsnotify package. It defines specific implementations for linux, osx and win32, and one umbrella module. A number of other modules contain common code, so duplication is really minimal.

Note that CPP is enabled only in the umbrella module for two reasons. First off all, it is used to import the specific implementation:

#ifdef OS_Linux
import System.FSNotify.Linux
#else
# ifdef OS_Win32
import System.FSNotify.Win32
# else
# ifdef OS_Mac
import System.FSNotify.OSX
# else
type NativeManager = PollManager
# endif
# endif
#endif

That can be avoided too. To do that we can give the same name to platform specific modules but move them into separate directories, linux, osx and win32. Then manipulate the hs-source-dirs field in cabal file to select the correct implementation. (Make sure to add other implementations to extra-source-files to make sure cabal sdist will copy them into the tarball.)

-- in System.FSNotify:
import System.FSNotify.Platform

-- in fsnotify.cabal:
extra-source-files: linux/System/FSNotify/Platform.hs
                    osx/System/FSNotify/Platform.hs
                    win32/System/FSNotify/Platform.hs
hs-source-dirs: src
if os(linux)
  hs-source-dirs: linux
if os(darwin)
  hs-source-dirs: osx
if os(windows)
  hs-source-dirs: win32

The other use of CPP is to define forkFinally that is missing in older base:

#if !MIN_VERSION_base(4,6,0)
forkFinally :: IO a -> (Either SomeException a -> IO ()) -> IO ThreadId
forkFinally action and_then =
  mask $ \restore ->
    forkIO $ try (restore action) >>= and_then
#endif

The same technique can be used to avoid CPP here. I personally prefer to hide such snippets into a custom prelude and don’t bother with hs-source-path.

(I don’t think CPP should be avoided at all costs, I think that the amount of CPP used in fsnotify is a good compromise. I just used it as a real world example of how to avoid CPP.)

More posts

Atom feed

(Originally posted here)

Exception handling is hard, and asynchronous exceptions make it even harder. But there are common patterns, that simplifies exception handling and make our life much easier. Here we will explore a widely used open source library, snap-server, and identify common issues, difficulties and mistakes. Also we’ll see how to avoid most of the mistakes and describe useful patterns. Thanks to Gregory Collins for letting me use snap-server here.

(I probably should note, that I’m snapframework user, and I like it. So the criticism here is friendly in it’s nature.)

The post is organized into a series of examples of real code. I’ll use this specific source code tree. We’ll mostly discuss simple, obvious cases.

example #1

sendFileFunc :: Socket -> SendFileHandler
sendFileFunc sock !_ builder fPath offset nbytes = bracket acquire closeFd go
  where
    sockFd    = Fd (fdSocket sock)
    acquire   = openFd fPath ReadOnly Nothing defaultFileFlags
    go fileFd = do sendHeaders builder sockFd
                   sendFile sockFd fileFd offset nbytes

Source

That is an example how your exception handling code should look like. Here bracket does most of heavy lifting to prepare safe environment. Acquire and cleanup actions effectively are library functions (from unix package).

Contract

So the function on itself is perfect. But it relies on library functions to be correct. Lets formulate explicitly the contract we are expecting:

• openFd should not leak file descriptor if it fails.

That is pretty natural requirement, because we will not get the file descriptor at all if openFd fails, so there is nothing we can do on our side.

• closeFd should not leak file descriptor if it fails.

That doesn’t look so natural, but the reason is the same – there is nothing we can do in case of failure.

Note: the contract should be preserved even in case of async exception, because there is no good way to distinguish async and sync exception.

In the ideal world we should not simply assume the contract is preserved, we should read documentation instead. Unfortunately the is no explicit contract in the documentation. Probably we should pester the maintainer. Anyway, we can either look for other library or use the existing.

Inspecting source code of dependencies

One may think that we should inspect source code of openFd and closeFd. It may be useful, but it doesn’t solve the issue. Unless the contract is explicitly states, the author is free to change it. But you can inspect the particular version of the unix package and commit yourself to it.

example #2

withLoggers afp efp act =
    bracket (do mvar <- newMVar ()
                let f s = withMVar mvar
                            (const $ S.hPutStr stderr s >> hFlush stderr)
                alog <- maybeSpawnLogger f afp
                elog <- maybeSpawnLogger f efp
                return (alog, elog))
            (\(alog, elog) -> do
                maybe (return ()) stopLogger alog
                maybe (return ()) stopLogger elog)
            (\(alog, elog) -> act ( liftM logMsg alog <|> maybeIoLog afp
                                  , liftM logMsg elog <|> maybeIoLog efp))

Source

The function spawns two loggers (using maybeSpawnLogger) and stops them (using stopLogger) on exit. It is not important what loggers do, but you can check the source code if you are interested.

Do you see any issue here? Probably not. Lets say the function has no obvious issues. (Actually I found one minor issue, but I spent half an hour reading code.) But it doesn’t mean the function is correct.

Don’t assume anything

I convinced myself that maybeSpawnLogger and stopLogger never throw exception. (Well, stopLogger is interruptible, so it actually can sometimes.) But is there any reason we need to assume that? What if someone change them when refactoring? Sometimes we need to rely on actions not to throw exception, but not here. Lets fix it:

withLoggers afp efp act =
    bracket (do mvar <- newMVar ()
                let f s = withMVar mvar
                            (const $ S.hPutStr stderr s >> hFlush stderr)
                bracketOnError
                  (maybeSpawnLogger f afp)
                  (maybe (return ()) stopLogger)
                  (\alog -> do
                    elog <- maybeSpawnLogger f efp
                    return (alog, elog))

            (\(alog, elog) -> do
                maybe (return ()) stopLogger alog
                `finally`
                maybe (return ()) stopLogger elog)
            (\(alog, elog) -> act ( liftM logMsg alog <|> maybeIoLog afp
                                  , liftM logMsg elog <|> maybeIoLog efp))

Here we did two fixes. First, we use bracketOnError to ensure the first logger will be stopped if we fail to spawn the second. Also finally is used to ensure the second logger will be stopped if the first one fails to stop. Pretty complicated, but now it is at least correct.

Note that the code is correct w.r.t. both sync and async exception. Here we did nothing special to handle async exceptions.

However the function still relies on maybeSpawnLogger and stopLogger to preserve the contract (see example #1).

Keep it simple

The function is still far from ideal. In the acquire action it does unnecessary work – allocates MVar. Is there any reason to do that inside bracket? Probably not. Lets simplify the code to make reasoning easer:

withLoggers afp efp act = do
    mvar <- newMVar ()
    let f s = withMVar mvar
                (const $ S.hPutStr stderr s >> hFlush stderr)

    bracket (do bracketOnError
                  (maybeSpawnLogger f afp)
                  (maybe (return ()) stopLogger)
                  (\alog -> do
                    elog <- maybeSpawnLogger f efp
                    return (alog, elog))

            (\(alog, elog) -> do
                maybe (return ()) stopLogger alog
                `finally`
                maybe (return ()) stopLogger elog)
            (\(alog, elog) -> act ( liftM logMsg alog <|> maybeIoLog afp
                                  , liftM logMsg elog <|> maybeIoLog efp))

Divide and conquer

The function is very complex and hard to reason still. But notice that there is no dependency between loggers here, so we can handle them separately. Lets use two brackets, one per logger:

withLoggers afp efp act = do
    mvar <- newMVar ()
    let f s = withMVar mvar
                (const $ S.hPutStr stderr s >> hFlush stderr)

    bracket (maybeSpawnLogger f afp)
            (maybe (return ()) stopLogger) $ \alog -> do

      bracket (maybeSpawnLogger f efp)
              (maybe (return ()) stopLogger) $ \elog -> do

        act ( liftM logMsg alog <|> maybeIoLog afp
            , liftM logMsg elog <|> maybeIoLog efp))

Now the function consists of two nested handlers, that are very similar to example #1. It is obviously correct.

Local reasoning

I’d like to draw your attention to the next. We reason about exception handling locally. Obviously all functions we use here affect exception safety of our code, but we use the contract (see example #1) to build a wall between our code and it’s dependencies. That is the only way to handle exceptions. Sometimes the contract is more complex, and we have to provide safe environment for our dependencies, but that should be explicitly stated in documentation.

We’ll discuss maybeSpawnLogger and stopLogger later, and you’ll see that the contract protects us from caller site too, allowing local reasoning.

example #3

Lets inspect maybeSpawnLogger. It is a simple wrapper over other function:

maybeSpawnLogger f (ConfigFileLog fp) =
    liftM Just $ newLoggerWithCustomErrorFunction f fp
maybeSpawnLogger _ _                  = return Nothing

newLoggerWithCustomErrorFunction :: (ByteString -> IO ())
                                 -> FilePath   -- ^ log file to use
                                 -> IO Logger
newLoggerWithCustomErrorFunction errAction fp = do
    q  <- newIORef mempty
    dw <- newEmptyMVar
    th <- newEmptyMVar

    let lg = Logger q dw fp th errAction

    mask_ $ do
      tid <- forkIOLabeledWithUnmaskBs "snap-server: logging" $
               loggingThread lg
      putMVar th tid

    return lg

Source

Don’t use mask_

In most cases it is wrong, so don’t use it unless you exactly know what you are doing. If newLoggerWithCustomErrorFunction action is called without async exceptions masked, then it will leak resource. It is too late to mask async exceptions here. Probably it should be stated in documentation to the function, but actually it is clear enough – it should be used only inside bracket or similar context. There is nothing wrong with mask_ here, it is just unnecessary. But it gives you false feeling of safety, and can be a sign of other issues.

One can think that mask_ here is useful because protects at least part of the code from async exceptions. But that is not true, async exceptions will be postponed till end of mask_, but then will be delivered anyway (unless masked on caller site). The result is the same – orphan thread.

Other issues

Lets identify all points where something can go wrong. First of all, the resource here is a thread, so we should make sure it doesn’t become orphan on failure. Everything above forkIOLabeledWithUnmaskBs is irrelevant, because the thread is not yet created here. The only point if failure is putMVar. To be carefull we should protect forkIOLabeledWithUnmaskBs against failure in putMVar, but it is not necessary.

From documentation it is clear, that it will not throw async exception unless the MVar is full. Here it is empty for sure. (Note: it is documented not in Control.Concurrent.MVar, but in Control.Exception.)

Unfortunately the documentation for putMVar doesn’t say anything about sync exceptions. (And it can throw at least BlockedIndefinitelyOnMVar, but not in our case.) But it is very common to rely on it not to throw sync exception, so nobody will break that assumption ever. We can think about it as a documentation bug.

Conclusion: the function is safe.

example #4

-- | Kills a logger thread, causing any unwritten contents to be
-- flushed out to disk
stopLogger :: Logger -> IO ()
stopLogger lg = withMVar (_loggingThread lg) killThread

Lets remember the contract: function should release resource even in case of failure. Well, it is not always possible, but it should do it’s best.

There is two IO actions here, withMVar and killThread. Both are potential points of failure.

Documentation for withMVar states:

it is only atomic if there are no other producers for this MVar.

The wording probably can be better. But it will not throw if the MVar is full initially and nobody tries to put anything into it until exit from withMVar. In out case it is true – the mvar is not used anywhere after spawning the thread. But we need to inspect the code around to find that out, so it would be better to document the design.

killThread is problematic though. AFAIK it can’t throw sync exceptions, but it can throw async exception even when wrapped into uninterruptibleMask (!!!). Also it is interruptible even when doesn’t block. You should read it’s documentation carefully before using it.

In this particular case it is enough to wrap killThread into uninterruptibleMask. Other option is to provide eventual guarantees, e.g. spawn other thread to do killThread asynchronously:

stopLogger lg = withMVar (_loggingThread lg) $ \threadId ->
  killThread threadId `onException` void (forkIO $ killThread threadId)

Here the ThreadId of the helper thread is unknown to anybody else, so we can be sure nobody will send async exception to it.

example #5

runLoops = E.bracket (mapM newLoop [0 .. (nLoops - 1)])
                     (mapM_ killLoop)
                     (mapM_ waitLoop)

Source

Do you see the issue here?

Never assume anything. What if one of newLoop fails? Then all already created loops will leak. What if one of killLoop fails? Then all subsequent loops will not be killed.

Note: It is possible that newLoop and killLoop never throw (not in our case though), but the principle of local reasoning forces us to handle exceptions here or at least write a comment. We probably should fold the killLoops with finally. Something like ResourceT can simplify this case a lot.

Final notes

Internally snap-server does a lot of non-local manipulations with mask state. It is hard to extract any meaningful example because of non-locality. I’ll simply provide a link The restore seems to be changing masking state, but it is not clear how it affects the code. Probably there are good reasons for such design though. Also eatException is used a lot, and that is a bad sign.

bracket is not the only source of errors, but the same approach can be applied to most cases.

I didn’t have a goal to uncover all issues with exception handling here. And I’m sure there are cases much harder to find and fix. But in most cases you’ll avoid a lot of mistakes if you follow the basic principles:

• Don’t assume anything

• Keep it simple

• Divide and conquer

• Reason locally

Thanks to all authors of snap-server for excellent library, I really appreciate your work.

More posts

Atom feed