dæmonology

My member of the U.S. House of Representatives is Jackie Speier (D-San Mateo).  I have just returned from her Families and Health Care Forum Event at Burton Park in San Carlos, which was attended by a few hundred constituents of which only a handful were unruly and disorderly protestors.  I have some news to report about what her press director told me personally at the meeting when I could not address my question directly to the congresswoman.

In my previous post, I whined about how it didn't seem to me that a pure-functional union-find data structure should be so hard to make as computationally efficient as the well-known imperative algorithms.  After some wonkulation on the subject, I convinced myself that— yes, bunky, it's true— functional purity really does cost extra, and sometimes it costs enough that it's worth sacrificing purity for efficiency.

• FIND returns the representative element of the set, and I'd rather the code allowed for the representative of the equivalence class to be of a type different than the set elements. This is because I'm planning to use the data structure in a constraint solver for type inference.

• Their code requires the elements to be integers suitable for indexing persistent arrays.  This is unacceptable for me.  I want an algorithm suitable for any totally ordered set of elements.

module type T = sig

    type k and +'a q and +'a t

    

    val nil: 'a t

    val start: k -> 'a -> 'a t

    val find: k -> 'a t -> 'a q option

    val extract: 'a q -> 'a

    val disjoint: 'a t -> 'a t -> 'a t

    val union: 'a q -> 'a q -> 'a t

end

module Create(K: Cf_ordered.Total_T) : (T with type k = K.t) = struct

    module U = Cf_rbtree.Set(K)

    module H = Cf_sbheap.PQueue(Cf_ordered.Int_order)

    

    type k = K.t

    

    type 'a q = Q of U.t * int * 'a * 'a t

    and 'a t = T of int * (k -> 'a q option)

    

    let void_ _ = None

    let nil = T (0, void_)

    

    let start k v =

        let q = Some (Q (U.singleton k, 1, v, nil)) in

        let f k' = if K.compare k k' <> 0 then None else q in

        T (1, f)

    

    let find k (T (_, f)) = f k

    let extract (Q (_, _, v, _)) = v

    

    type 'a compressor = {

        mutable z: int;

        mutable h: 'a q H.t;

        mutable u: U.t;

        mutable f: k -> 'a q option;

    }

    

    let compress_ =

        let rec loop c k h =

            if U.member k c.u then

                None

            else

                match H.pop h with

                | Some (hd, tl) ->

                    let _, q = hd in

                    let Q (u, _, _, _) = q in

                    if U.member k u then Some q else loop c k tl

                | None ->

                    if c.z = 0 then

                        None

                    else

                        match c.f k with

                        | None ->

                            c.u <- U.put k c.u;

                            None

                        | Some q as q1 ->

                            let Q (_, n, _, _) = q in

                            c.h <- H.put (n, q) c.h;

                            let z = c.z - n in

                            assert (z >= 0);

                            c.z <- z;

                            if z == 0 then begin

                                c.f <- void_;

                                c.u <- U.nil

                            end;

                            q1

        in

        fun c k ->

            loop c k c.h

    

    let disjoint a b =

        if a == b then

            a

        else begin

            let T (na, fa) = a and T (nb, fb) = b in

            let n = na + nb in

            let f =

                if n > 1 then begin

                    let f1, f2 = if na > nb then fa, fb else fb, fa in

                    fun k -> match f1 k with Some _ as q -> q | None -> f2 k

                end

                else if n > 0 then begin

                    if na > 0 then fa else fb

                end

                else

                    void_

            in

            let c = { z = n; h = H.nil; u = U.nil; f = f } in

            T (na + nb, compress_ c)

        end

    

    let union a b =

        let Q (ua, na, v, ta) = a and Q (ub, nb, _, tb) = b in

        if ta == tb && ua == ub then

            ta

        else begin

            let qn = na + nb in

            let T (n, f) as t = disjoint ta tb in

            let z = n - qn in

            assert (z >= 0);

            let rec q = Q (U.union ua ub, qn, v, t)

            and c = lazy { z = n; h = H.put (n, q) H.nil; u = U.nil; f = f } in

            let c = Lazy.force c in

            T (n, compress_ c)

        end

end

...is apparently not terribly efficient.  This makes me sad.  The problem doesn't seem like it should be as hard as it appears to be.  This makes me more sad.

Apparently, the ghost of Jon Postel is leading a pack of superheroes determined to defend the Internet from Fear Uncertainty and Doubt.  Promote The Internet Way with Team ARIN!

Welcome to the world of Team ARIN! We hope you find these publications educational and entertaining. Team ARIN is a fictionalized view of the American Registry for Internet Numbers (ARIN), its processes, and the whole concept of Internet governance. Though our heroes are fictional, the issues they face are very real.

Team ARIN is a group of superheroes that represent four of the principles by which the Internet is operated and governed...

The Problem With Software Transactional Memory: Your Languages Still Suck.

Classic threads and locks (or threads and synchronized, for you Java programmers) lead to the worst sort of Heisenbugs. True story: I once had to trace down a race condition that, doing several thousand tests per second, only manifested itself once every four days on average. The vast majority of the time it’d work just fine- the rate of failure was small enough it had escaped testing (think about it- you’ve been running the same test, thousands of times a second, for three days, and it hasn’t failed yet- when do you declare that it looks like the test is working?), but it was common enough that it was causing our customer to lock up about once a week, so it had to get fixed. Oh, and threads and locks aren’t compositional- you can’t take two hunks of code which are individually correct, and combine them to form one large, correct, piece of code. But hey, it’s not like code reuse is that important to programmers, is it?

I seem to have one.  Here's the OCaml signature.  The module file is all of 250 lines at this point, but I expect to define a lot of built-in processes for the preamble.  That will bloat out the module file.

type 'a t

module Op: sig
val ( >>= ): 'a t -> ('a -> 'b t) -> 'b t
end

val return: 'a -> 'a t
val eval: unit t -> unit

type n
type repeat = Once | Always

val nil: unit t
val start: unit t -> unit t
val lambda: n t
val nu: n t
val fusion: n -> repeat -> n list -> unit t -> unit t

val v_void: n
val v_true: n
val v_false: n

val if_then_else: n -> unit t -> unit t -> unit t

type dio = D_in | D_out
val def: dio list -> (n array -> unit t) -> n t

val preamble: n Name.Map.t t

I want my coins back.

I continue to noodle around with an abstract syntax for types in my internal language.  (Sigh.  This is taking forever.)  Here's what I'm looking at now:

While I was in the shower this morning, it occurred to me that I should make a note for myself about how monads work in the polyadic D-fusion calculus.