Ten Cache Misses

Crushing Haskell like a Tin Can

Generics and Protocol Buffers: The Hackage Years

Last year I spent some time exploring GHC.Generics as a language for describing Protocol Buffers messages. Steve and I pushed just hard enough to get a real implementation out the door and it’s finally available on Hackage.

This package avoids the typical/traditional Protocol Buffers flow of defining messages in a .proto file and running a preprocessor to generate code in some target language(s). Instead, we’ll define messages in Haskell and generate .proto files for interoperability 1. A skeleton of a protoc plugin is starting to take shape too.

There are a couple quirks when using it today. The main downside (imo) is the dependency on the type-level package. Come GHC 7.8.1 it should be possible to switch to GHC.TypeLits. I’d also like to provide a more seamless path for mapping existing datatypes to a Protocol Buffers message.

It’s an early release but please check it out, kick the tires a bit, and let me know what you think. Send pull requests and track issues on Github.

The current syntax differs slightly from the original blog post. Encoding and decoding is still performed using cereal. More comprehensive docs and samples are available on Hackage or in the git repo.

Given a boilerplate module:

1
2
3
4
5
6
7
{-# LANGUAGE DeriveGeneric, OverloadedStrings #-}
import Data.Int
import Data.ProtocolBuffers
import Data.TypeLevel (D1, D2, D3, D4)
import Data.Text
import Data.Word
import GHC.Generics (Generic)

We can define some messages. Fields are defined using type functions such as Required, Optional, Repeated and Packed. A type-level number (D1, D2 .. Dn) defines the field tag. And the encoding style is selected with Value (for scalars and strings), Enumeration or Message.

Scalar encoding will default to the traditional varint format unless you choose otherwise: Value (Fixed a) (fixed-width) and Value (Signed a) (zz-encoded) forms are supported for integers.

A basic message might contain a bunch of values:

1
2
3
4
5
6
data Simple = Simple
  { field1_a :: Required D1 (Value Int64) -- ^ The last field with tag = 1
  , field2_a :: Optional D2 (Value Text) -- ^ The last field with tag = 2
  , field3_a :: Repeated D3 (Value Bool) -- ^ All fields with tag = 3, ordering is preserved
  , field4_a :: Packed D4 (Value Word32) -- ^ A packed sequence, ordering is preserved
  } deriving (Generic, Show)

Or we can define some regular Haskell enums and reference other messages:

1
2
3
4
5
6
7
8
9
10
data Color
  = Red
  | Green
  | Blue
    deriving (Enum, Show)

data Complex = Complex
  { field1_b :: Optional D1 (Enumeration Color) -- ^ This field is converted using Enum
  , field2_b :: Required D2 (Message Simple) -- ^ An embedded message
  } deriving (Generic, Show)

And encode them to ByteStrings:

1
2
3
4
5
6
7
8
9
runPut . encodeMessage $ Complex
  { field1_b = putField Green
  , field2_b = putField Simple
      { field1_a = putField 42
      , field2_a = putField "some text"
      , field3_a = putField [True, True, False, False]
      , field4_a = putField [1..10]
      }
  }

Encoding is basically just the opposite: runGet, decodeMessage and getField are the tools of choice.


  1. Eventually, at least. A proof of concept code generator is included but not yet functional.

Ragel primops and the GHC stack

Quite a few people have been asking about a follow up to an old post, specifically on dealing with passing return values on the stack from our C/LLVM based primop. I ended up with some unexpected free time today on the Caltrain waiting for a crushed tractor-trailer to get cleared off the tracks and dusted off a semi-functional feed parser in the style of Tsuru’s code sample. Sample data for is much easier to find than NASDAQ’s ITCH feed, I hope it’s also easier for you to get started with.

As with C, allocating from GHC’s stack is almost as simple as bumping a pointer. Unlike (most) C code, Haskell applications must explicitly check the stack to verify there is space available before performing the allocation. This is quite a bit more of a pain to deal with in C compared to C– or Haskell because stack allocations are done via tail-calls, we will ignore this detail for now and just assume the stack is large enough.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
extern void
QuoteParser_run(
    int64_t* restrict baseReg,
    int64_t* restrict sp,
    ...)
{
    // TODO: check to see if sp has room for 4 more values

    // allocate space for 4 values on the stack
    int64_t* nextSp = &sp[-4];

    // assign some value to each unboxed primitive
    sp[-1] = 0xfdfdfdfdfdfdfdfd;
    sp[-2] = 0xabababababababab;
    sp[-3] = 0x1717171717177171;
    sp[-4] = 0x3535353535353535;

    // pass the updated stack pointer along to a function
    // expecting 10 integers to be returned from this primop:
    // 6 in registers R1-R6 and 4 on the stack
    nextFunction(baseReg, nextSp, ...);
}

The full code is available on Github for your forking pleasure.

Cabal: a Haskell eDSL?

While I’m working on more radical ideas about Hackage and Cabal, I thought I’d stick out a couple more palatable ones now.

Cabal (almost always?) links an executable whenever cabal install <some package> is run. Combined with a slow linker such as OSX’s… and well, it’s slow. The generated application is almost always a shim around the (compiled) Cabal library, so linker step can probably be removed entirely. The general design permits the installer to select which version of the Cabal library to use, cabal-install just provides the bootstrap. I think this could be done done with runhaskell or runghc instead.

When porting our build system from cabal-waf to shake-install I decided to carry forward WAF’s use of the host language (WAF uses Python) as the Makefile language. Haskell seems like a natural way to describe the build hierarchy for Haskell projects, though shake-install reads dependencies from .cabal files. Could this idea be further extended to replace Cabal’s language entirely with an eDSL? Link in GHC as an interpreter and you’ve got a fast Haskell build system.

Monadic, applicative or monoidal. This is just an idea without implementation.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
import Cabal

-- equivalent of 'Main :: IO ()' for Cabal installers
cabal :: Cabal Package
cabal = package "sample" $ do
  language Haskell2010
  license BSD3

  library "demo" $ do
    depends $ do
      "base"         (==? any)
      "stm"          (>=? "2.3")
      "transformers" ((>=? "1.0") <> (<=? "2.0"))

    options GHC $ do
      "-Wall"
      "-fno-warn-foo"

    modules $ do
      exposed "MyPackage.MyExposedModule"
      hidden  "MyPackage.MyHiddenModule"

Updatable timeouts for your transformer stacks

A relatively common issue we have dealing with pubsub services on the internet is reliability. Conceptually it should be simple: connect, subscribe and then data flows magically for the rest of time. Reality comes well short of our desires. We use a very large pubsub service to consume 140 character messages… and sometimes it just decides to stop sending new messages after a few days. They’re not alone either. The timeout function in base almost does what we want but falls short in one key area: extending the timeout duration.

I was dredging through the GHC event manager a while ago for an unrelated reason and stumbled upon updatable timers, hidden in the depths of GHC.Event. I figured it would be more useful as a monad transformer, and so timeout-control was born.

Like many unsupported features in GHC, it melted down two of our servers and taught me exactly what 42 means… but I think most of the kinks have been worked out since. We’ve been using it in production for quite a while now without issue. It was originally written for use with our (legacy) enumerator codebase and now with conduits. Providing your code is exception safe it may work for you too. Find it on Hackage or fork it on Github.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
import Control.Monad.Trans (liftIO)
import Data.Conduit (($$), (=$), runResourceT)
import qualified Data.Conduit.List as Cl
import Data.Conduit.Network (ClientSettings(..), runTCPClient)
import System.Timeout.Control (Microseconds, runTimeout, updateTimeout)

main :: IO ()
main = do
  -- the event manager uses microsecond resolution
  let oneSecond :: Microseconds
      oneSecond = 1000000
      settings  = ClientSettings{clientHost = "127.0.0.1", clientPort = 8888}

  -- evaluate a timeout action, starting with a 10 second timeout
  res <- runTimeout (10 * oneSecond) $ do
         runTCPClient settings $ \ source sink ->
              source
           -- set the timeout to t+5 seconds whenever data arrives from the server
           $$ Cl.mapM  (\ val -> updateTimeout (5 * oneSecond) >> return val)
           -- and print out the received bytes
           =$ Cl.mapM_ (liftIO . print)

  case res of
    Left exc -> putStrLn $ "Action timed out: " ++ show exc
    Right () -> putStrLn $ "Action ran to completion"

The Great GHC Primop Shootout

I’ve terribly hacked glued together a few microbenchmarks comparing the LLVM primop madness against a more traditional FFI and a native Haskell deserializer. The FFI “parser” used here is a bit contrived as it’s primarly measuring Storable and FFI overhead and does no parsing, but it’s interesting all the same. Send pull requests with a more full featured implementation and I’ll update this post accordingly.

As always, the code for this post is available on Github.

Labels
  • primop: The Clang mangled primop parser, multiple return results are passed in STG registers
  • lotsa: Each return result (out parameter) is allocated and marshalled individually
  • justOne: A Storable instance is used to marshal the return results all at once
  • cereal: A native Haskell deserializer using the cereal package

The chart was lifted from a much larger report, courtesy of Criterion.

Generics and Protocol Buffers

We use Protocol Buffers extensively, and from talking to some folks at BayHac'12 it may be time to revisit the state of protobuf in Haskell.

To be fair, the protocol-buffers package is great. It’s extremely full featured, well tested and I can’t complain about the performance. But when most parties involved are running Haskell, maintaining separate .proto files is more than just a chore. Properly integrating the hprotoc preprocessor into a build system has also proven to be a challenge primarily due to the n:m mapping of source files to target modules.

After spending a little time this evening hacking around, I’ve come up with an alternate solution that looks promising and doesn’t require external files or additional build tools. Though it’s far from a production effort, the type-level version of the code is available on Github for all your forking needs.

Note: GHC 7.2 or up is required for Generic support.

So what does it look like?

By defining a set of types that allow tagging a record field with a field number…

1
2
3
newtype Required (n :: Nat) t = Required t
newtype Optional (n :: Nat) t = Optional t
newtype Packed   (n :: Nat) t = Packed t

and a few more to override the default base-128 varint encoding

1
2
newtype Fixed t  = Fixed t
newtype Signed t = Signed t

… should give you enough rope to write regular Haskell records that are efficiently (de)serialized with very little fuss. Create an annotated record, derive a Generic instance and you’re done.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}

import Data.Hex (unhex)
import Data.Monoid (Last)
import Data.Serialize (runGet)
import Data.Text (Text)
import GHC.Generics

data TestRec = TestRec
  { field1 :: Required 1 (Last Int64)
  , field2 :: Optional 2 (Last Text)
  , field3 :: Optional 3 (Last Int64)
  } deriving (Generic, Show)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
*Pb> print $ runGet decodeMessage =<< unhex "089601120774657374696e67"
TestRec
  { field1 = Required (Last {getLast = Just 150})
  , field2 = Optional (Last {getLast = Just "testing"})
  , field3 = Optional (Last {getLast = Nothing})
  }

*Pb> print $ runGet decodeMessage =<< unhex "089601189701"
TestRec
  { field1 = Required (Last {getLast = Just 150})
  , field2 = Optional (Last {getLast = Nothing})
  , field3 = Optional (Last {getLast = Just 151})
  }

*Pb> print $ runGet decodeMessage =<< unhex "089601"
TestRec
  { field1 = Required (Last {getLast = Just 150})
  , field2 = Optional (Last {getLast = Nothing})
  , field3 = Optional (Last {getLast = Nothing})
  }

As you should expect in Haskell, changing a field to an unsupported type such as an Int will reward you with a nice (if not misleading) build break:

1
2
3
data TestRec = TestRec
  { field3 :: Optional 3 (Last Int)
  } deriving (Generic, Show)
1
2
3
4
5
6
7
Pb.hs:272:27:
    No instance for (Wire Int)
      arising from a use of `decodeMessage'
    Possible fix: add an instance declaration for (Wire Int)
    In the first argument of `runGet', namely `decodeMessage'
    In the first argument of `(=<<)', namely `runGet decodeMessage'
    In the expression: runGet decodeMessage =<< unhex "089601"

Update: 2/8/2013:

Steve and I are working on completing this work, check out our progress on Github.

Parsing Market Data with Ragel, clang and GHC primops

From time to time, I have the need to parse relatively small, fixed width binary messages. Like a ITCH 4.1 MoldUDP64 packet from our buddies over there at NASDAQ. Parsing should also be reasonably quick. And I’m lazy. Writing parsers by hand Maintaining handwritten parsers is no fun.

So I’m going to define our parser in Ragel, a parser generator for regular languages (think: regular expressions). It targets C/C++ and some other languages I don’t care about. Like Objective-C, D, Java and Ruby. We’ll focus on C99.

This example parser will handle a cut-down view of the ITCH spec. The full source for this post is available over on GitHub. We’re looking for order executions:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
machine ITCHv41;

# Common fields for both Order Executed messages
nanoseconds           = any{4} >{ nanos    = __builtin_bswap32(*(const uint32_t*)(p)); };
orderExecutedShares   = any{4} >{ shares   = __builtin_bswap32(*(const uint32_t*)(p)); };
orderExecutedMatchNum = any{8} >{ matchNum = __builtin_bswap64(*(const uint64_t*)(p)); };
orderExecutedRefNum   = any{8} >{ refNum   = __builtin_bswap64(*(const uint64_t*)(p)); };

orderExecutedCommon = orderExecutedRefNum
                      orderExecutedShares
                      orderExecutedMatchNum;

# 4.5.1 Order Executed Message
orderExecuted = 'E' %{ type = 1; }
                nanoseconds
                orderExecutedCommon;

# 4.5.2 Order Executed With Price Message
orderExecutedPrintable = 'Y' %{ printable = true;  }
                       | 'N' %{ printable = false; };

orderExecutedPrice = any{4} >{ price = __builtin_bswap32(*(const uint32_t*)(p)); };

orderExecutedWithPrice = 'C' %{ type = 2; }
                         nanoseconds
                         orderExecutedCommon
                         orderExecutedPrintable
                         orderExecutedPrice;

main := orderExecuted | orderExecutedWithPrice;

Ragel’s compiler does a bunch of optimization and pumps out a hot mess of GOTOs that regular C compilers like gcc, icc and clang eat for breakfast every day. This parser really isn’t very exciting:

Particularly when compared to a complete, validating ITCH parser:

An autovectorizing compiler can turn these state machines into machine code on par with some of the finest hand-rolled parsers. clang/LLVM does a decent job, adequate for now… but it also has some magic just hidden below the surface for Haskell developers. Namely an LLVM backend.

Typically we’d go ahead and consume parsers like these in GHC with a vanilla foreign import. But even with an unsafe import there is a relatively fixed amount of overhead due to switching calling conventions and loading out parameters. Normally this isn’t such a big deal, but we’re dealing with a lot of packets during simulation, billions and billions, and I’d like to dedicate some CPU to a task more productive than parsing.

To adopt GHC’s calling convention, we need to make our C code look enough like Haskell so they’ll play nice together. The first step is to define a function signature that looks like a regular STG function. The same thing that GHC generates. Like so:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
extern void
ITCHv41_run(
    int64_t* restrict baseReg,
    int64_t* restrict sp,
    int64_t* restrict hp,
    const uint8_t* restrict buffer, // R1
    int64_t length, // R2
    int64_t r3,
    int64_t r4,
    int64_t r5,
    int64_t r6,
    int64_t* restrict spLim,
    float f1,
    float f2,
    float f3,
    float f4,
    double d1,
    double d2)

This is still a ccall function but we’ll fix that later. There is currently no way to define this as cc10 (LLVM’s internal name for GHC’s calling convention) in clang.

Step two is to jump to the return address, which lives on top of the STG stack (the sp argument)… with the desired arguments, like the results of parsing, in tow. This is a regular function call that gets converted to a tailcall later on by llc, LLVM’s native compiler, when using cc10.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
// define a function pointer type that matches the STG calling convention
typedef void (*HsCall)(int64_t*, int64_t*, int64_t*, int64_t, int64_t, int64_t, int64_t,
                       int64_t, int64_t, int64_t*, float, float, float, float, double, double);

// Invoke the parser defined in our Ragel code
%% write exec;

const HsCall fun = (HsCall)sp[0];

// and then "return" our parameters as an unboxed tuple back to Haskell land
return fun(
    baseReg,
    sp,
    hp,
    type,
    nanos,
    shares,
    price,
    matchNum,
    refNum,
    spLim,
    undef,
    undef,
    undef,
    undef,
    undef,
    undef);

Compile it down to LLVM assembly…

1
2
ragel -G2 ITCHv41.rl -o ITCHv41.c
clang -O3 -emit-llvm -S ITCHv41.c -o ITCHv41.ll

And run it through sed to fix up the calling convention for the code generator… this is the magic part. Note: this is also overly general and will break any legit C calls. llc then pumps out an object file that GHC will link with later:

1
2
sed -e 's/call void/call cc10 void/; s/define void/define cc10 void/;' < ITCHv41.ll > ITCHv41.llp
llc -O3 -relocation-model=static -filetype=obj ITCHv41.llp -o ITCHv41.o

The last bit is to create a foreign primop import in Haskell. Many messages don’t fit within the 5 free registers (R2-R6) that are available here and need to be partially loaded onto the stack. In this example I’m just discarding the ‘printable’ flag to make everything fit in registers. Managing the stack is more involved. Perhaps I’ll cover it in a future post.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE GHCForeignImportPrim #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples  #-}
{-# LANGUAGE UnliftedFFITypes #-}

foreign import prim "ITCHv41_run"
  parseITCHv41# :: Addr# -> Word# -> (# Int#, Word#, Word#, Word#, Word#, Word# #)

data ITCHv41
  = OrderExecuted
      { nanos    :: {-# UNPACK #-} !Word64
      , refNum   :: {-# UNPACK #-} !Word64
      , shares   :: {-# UNPACK #-} !Word64
      , matchNum :: {-# UNPACK #-} !Word64 }
  | OrderExecutedWithPrice
      { nanos    :: {-# UNPACK #-} !Word64
      , refNum   :: {-# UNPACK #-} !Word64
      , shares   :: {-# UNPACK #-} !Word64
      , matchNum :: {-# UNPACK #-} !Word64
      , price    :: {-# UNPACK #-} !Word64 }
  | OtherMessage
      { status   :: {-# UNPACK #-} !Int64 }

-- | invoke the parser primop and allocate a record with the results
parseITCHv41 :: Ptr Word8 -> Word -> ITCHv41
parseITCHv41 (Ptr buffer) (W# length) = case parseITCHv41# buffer length of
  (# 1#, nanos, shares,     _, matchNum, refNum #) ->
     OrderExecuted (W64# nanos) (W64# refNum) (W64# shares) (W64# matchNum)

  (# 2#, nanos, shares, price, matchNum, refNum #) ->
     OrderExecutedWithPrice (W64# nanos) (W64# refNum) (W64# shares) (W64# matchNum) (W64# price)

  (# status, _,      _,     _,        _,      _ #) ->
     OtherMessage  (I64# status) -- insert other error handling here

Update 5/23/2012:

I spent an hour hacking together a simple benchmark suite and posted the results. If you’ve kept reading this far you might find it interesting.

Converting .cabal files to .json

Someone on #haskell last night was looking for a tool to convert a cabal-install package description to JSON. I hacked something together a while back to do exactly this for the cabal-waf project. While it’s not worthy of a standalone release on hackage it might be useful for someone else out there.

The source is also available for your cloning pleasure on GitHub. Enjoy.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
{-# OPTIONS_GHC -fno-warn-deprecations #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE TemplateHaskell #-}

module Main (main) where

import Control.Monad (when)
import qualified Data.ByteString.Lazy as BL
import Data.List
import Data.Aeson
import Data.Aeson.TH
import Distribution.ModuleName (ModuleName)
import Distribution.Package
import Distribution.PackageDescription
import Distribution.PackageDescription.Configuration
import Distribution.PackageDescription.Parse (readPackageDescription)
import Distribution.Verbosity
import Distribution.Version
import Distribution.License
import Distribution.Compiler
import Language.Haskell.Extension
import System.Environment (getArgs)

deriveJSON id ''PackageDescription
deriveJSON id ''PackageIdentifier
deriveJSON id ''PackageName
deriveJSON id ''Version
deriveJSON id ''SourceRepo
deriveJSON id ''RepoKind
deriveJSON id ''RepoType
deriveJSON id ''BuildType
deriveJSON id ''Library
deriveJSON id ''Executable
deriveJSON id ''TestSuite
deriveJSON id ''License
deriveJSON id ''CompilerFlavor
deriveJSON id ''TestSuiteInterface
deriveJSON id ''BuildInfo
deriveJSON id ''ModuleName
deriveJSON id ''Dependency
deriveJSON id ''Language
deriveJSON id ''Extension
deriveJSON id ''KnownExtension
deriveJSON id ''TestType
deriveJSON id ''VersionRange

main :: IO ()
main = do
  args <- getArgs
  when (length args == 0) $ fail "missing .cabal file"

  let (source:_) = args
  gdesc <- readPackageDescription normal source
  let desc = flattenPackageDescription gdesc
      bs = encode . toJSON $ desc
  BL.putStrLn bs

Running it on a small-ish .cabal file…

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
name:           ghc-prim
version:        0.2.0.0
license:        BSD3
license-file:   LICENSE
maintainer:     libraries@haskell.org
bug-reports: http://hackage.haskell.org/trac/ghc/newticket?component=libraries%20%28other%29
synopsis:       GHC primitives
description:
    GHC primitives.
cabal-version:  >=1.6
build-type: Custom

source-repository head
    type:     git
    location: http://darcs.haskell.org/packages/ghc-prim.git/

flag include-ghc-prim {
    Description: Include GHC.Prim in exposed-modules
    default: False
}

Library {
    build-depends: rts
    exposed-modules:
        GHC.Classes
        GHC.CString
        GHC.Debug
        GHC.Generics
        GHC.Magic
        GHC.PrimopWrappers
        GHC.IntWord64
        GHC.Tuple
        GHC.Types

    if flag(include-ghc-prim) {
        exposed-modules: GHC.Prim
    }

    c-sources:
        cbits/debug.c
        cbits/longlong.c
        cbits/popcnt.c
    extensions: CPP, MagicHash, ForeignFunctionInterface, UnliftedFFITypes,
                UnboxedTuples, EmptyDataDecls, NoImplicitPrelude
    -- We need to set the package name to ghc-prim (without a version number)
    -- as it's magic.
    ghc-options: -package-name ghc-prim
}

Produces output that is easier to consume outside of Haskell. It’s worth noting that conditional statements in the .cabal script are resolved, so the if flag statement above results in GHC.Prim being listed as an exposedModule.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
{"author":""
,"bugReports":"http://hackage.haskell.org/trac/ghc/newticket?component=libraries%20%28other%29"
,"buildDepends":[["rts",{"AnyVersion":[]}]]
,"buildType":{"Custom":[]}
,"category":""
,"copyright":""
,"customFieldsPD":[]
,"dataDir":""
,"dataFiles":[]
,"description":"GHC primitives."
,"executables":[]
,"extraSrcFiles":[]
,"extraTmpFiles":[]
,"homepage":""
,"library":
  {"exposedModules":
    [["GHC","Classes"]
    ,["GHC","CString"]
    ,["GHC","Debug"]
    ,["GHC","Generics"]
    ,["GHC","Magic"]
    ,["GHC","PrimopWrappers"]
    ,["GHC","IntWord64"]
    ,["GHC","Tuple"]
    ,["GHC","Types"]
    ,["GHC","Prim"]]
  ,"libBuildInfo":
    {"buildTools":[]
    ,"buildable":true
    ,"cSources":["cbits/debug.c","cbits/longlong.c","cbits/popcnt.c"]
    ,"ccOptions":[]
    ,"cppOptions":[]
    ,"customFieldsBI":[]
    ,"defaultExtensions":[]
    ,"defaultLanguage":null
    ,"extraLibDirs":[]
    ,"extraLibs":[]
    ,"frameworks":[]
    ,"ghcProfOptions":[]
    ,"ghcSharedOptions":[]
    ,"hsSourceDirs":["."]
    ,"includeDirs":[]
    ,"includes":[]
    ,"installIncludes":[]
    ,"ldOptions":[]
    ,"oldExtensions":
      [{"EnableExtension":{"CPP":[]}}
      ,{"EnableExtension":{"MagicHash":[]}}
      ,{"EnableExtension":{"ForeignFunctionInterface":[]}}
      ,{"EnableExtension":{"UnliftedFFITypes":[]}}
      ,{"EnableExtension":{"UnboxedTuples":[]}}
      ,{"EnableExtension":{"EmptyDataDecls":[]}}
      ,{"DisableExtension":{"ImplicitPrelude":[]}}]
    ,"options":[[{"GHC":[]},["-package-name","ghc-prim"]]]
    ,"otherExtensions":[]
    ,"otherLanguages":[]
    ,"otherModules":[]
    ,"pkgconfigDepends":[]
    ,"targetBuildDepends":[]}
  ,"libExposed":true}
,"license":{"BSD3":[]}
,"licenseFile":"LICENSE"
,"maintainer":"libraries@haskell.org"
,"package":{"pkgName":"ghc-prim","pkgVersion":{"versionBranch":[0,2,0,0],"versionTags":[]}}
,"pkgUrl":""
,"sourceRepos":
  [{"repoBranch":null
   ,"repoKind":{"RepoHead":[]}
   ,"repoLocation":"http://darcs.haskell.org/packages/ghc-prim.git/"
   ,"repoModule":null
   ,"repoSubdir":null
   ,"repoTag":null
   ,"repoType":{"Git":[]}}]
,"specVersionRaw":
  {"Right":
    {"UnionVersionRanges":
      [{"ThisVersion":{"versionBranch":[1,6] ,"versionTags":[]}},
       {"LaterVersion":{"versionBranch":[1,6],"versionTags":[]}}]}}
,"stability":""
,"synopsis":"GHC primitives"
,"testSuites":[]
,"testedWith":[]}

Building Large Haskell Projects with waf

I just published a little Cabal tool for waf to GitHub. We’ve been using it for quite a while for our builds, including a CI buildbot. Managing a moderate number of packages with cabal-install was getting to be a hassle… and supporting multiple languages (primarily concerning C++) in one build system was a looming requirement. cabal-dev might be an alternative for pure Haskell shops, though I haven’t used it.

There is a simple tutorial over on GitHub that should cover the basics, if you’re in need of a faster build. I’ll spare the details here.

In order to get decent parallel build performance I broke up the cabal install steps into smaller peices, and left out some features like Haddock support. The basic process is:

  1. cabal configure
  2. cabal build
  3. cabal copy
  4. cabal register –gen-pkg-config
  5. ghc-pkg update
  6. touch – a dummy step for enforcing cross package dependencies

cabal haddock should slot in somewhere up there, probably as a parallel task to cabal build.

ghc-pkg register is serialized across all packages to prevent the registration database from being corrupted. The remaining steps are always run in sequence for each package… unless you’re building executable-only packages. Then registration isn’t supported and just leads to build failures.

The rest of the build is handled in parallel, much like make. I added an additional dummy step to track cross package dependencies, something that should be cleaned up (by reading the registration script?). I’d also like to parse the .cabal scripts and tease out the in-tree dependencies so that they don’t need to be specified twice. Work for another day though.

This is what our build looks like. The heavy use of Rank-N types in a few packages leads to a slow first build (though they are carefully segregated to reduce rebuild times), as you can see here. This covers about 15 minutes. Charts are courtesey of parallel_debug:

Edit just one file, in this case a heavily used module in our Prelude overlay, and waf will rebuild the offending package first followed by all dependents in the correct order. This time around the build shows very good parallelism, keeping all 8 cores busy, finishing in about a minute.