Writing a pi-calculus compiler in F# (Part VI): The code generator

Just joining us? We’re writing a compiler for the π-calculus in F#—Part I explains. Continuing from last time? Need a refresher? We just sketched our runtime library. Time to generate code!

 

To generate code we will need to carry around some contextual information. I’m guessing that, at the method level, we will need something that maps variables to storage for those variables, and something that maps processes to the means of starting those processes. For both of these things we can use an assoc list; a list of pairs that has a ‘key’ in the first part and the value in the second part:

 

open Microsoft.AbstractIL.Internal.Nums

 

 

(* code-generation context *)

 

type storage_context = (id * storage) list

 

and storage =

      | Local of u16

      | Field of field_spec

 

type closure_context = (proc * type_ref) list

 

type context = storage_context * closure_context

 

Here we’ve said storage is either a numbered local variable or a field. That feels right—processes that receive more data or create fresh names can stick them in local variables. Variables captured from the context as processes are started can be stuck in fields. field_spec is an AbsIL field reference.

 

For the mapping of processes to means of starting processes, I’ve just used a type_ref—an  AbsIL type reference. Because we’re generating all of the code we can follow a convention where processes are compiled into closure classes which have a constructor and a method called Run, and a type_ref is enough to construct references to the constructor and Run method.

 

Now let’s generate the tiniest possible fragment of code for part of a process:

 

let rec gen_proc p entry_label ctx =

      match p with

      | Inert ->

            mk_bblock

                  { bblockLabel = entry_label;

                    bblockInstrs = [| I_ret |] },

            ctx

      …

 

I’ve decided this function takes a process p, the label it should use as an entry point and the context we talked about. Compiling the inert process is easy—it just exits straight away. mk_bblock makes a basic block, part of AbsIL’s model of IL code. This model is explained very well in the comment near the type code = definition in lib\il.mli in the AbsIL distribution.

 

Sending messages requires looking the receiver and message up in the storage context. Let’s write a helper to do that:

 

let mk_load ctx var =

      try

            match List.assoc var (fst ctx) with

            | Local n ->

                  [I_ldloc n]

            | Field f ->

                  [I_ldarg (int_to_u16 0);

                   mk_normal_ldfld f]

      with Not_found ->

            failwith ("undeclared variable '" ^ var ^ "' in scope variables: " ^ any_to_string (fst ctx))

 

This takes the context and a variable and generates a tiny fragment of code to push the variable onto the evaluation stack. Now let’s use it to generate code to send a message:

 

      | Send (ch, v, q) ->

            let q_entry = generate_code_label "" in

            let send_code = mk_bblock

                  { bblockLabel = entry_label;

                    bblockInstrs = Array.of_list

                        (mk_load ctx ch @

                         mk_load ctx v @

                         [ mk_normal_call send_mspec;

                           I_br q_entry ])} in

            let q_code, ctx' = gen_proc q q_entry ctx in

            join_code send_code q_code, ctx'

 

This is more complex and draws together a lot of what we have laid out so far. First we make up a label that will be the entry label of the next step in the process. Then we generate code, using our mk_load helper, to push the channel and message onto the evaluation stack. We call Channel::Send in the runtime library using the send_mspec metadata we wrote earlier. Finally we generate the next bit of code in the process and stitch together the result.

 

Notice how gen_proc actually yields two values: code and an updated context? This is preparation for compiling concurrent processes later. For now just notice how the context is threaded through the evaluation.

 

To generate code to receive a message, we need to have somewhere to store what we receive. Let’s make a helper for that:

 

let locals_of_context ctx =

      let is_local (_, s) =

            match s with

            | Local _ -> true

            | _           -> false

      in

      List.filter is_local (fst ctx)

 

let mk_store ctx var =

      let n = int_to_u16 (List.length (locals_of_context ctx)) in

      [I_stloc n],

      ((var, Local n) :: fst ctx, snd ctx)

 

This looks at how many locals are in the context, adds a mapping from var to the next local (locals are numbered from zero in the CLR) and gives a stloc instruction to pop the top of the evaluation stack and store it in the new local. Now to use it:

 

      | Recv (ch, v, q) ->

            let q_entry = generate_code_label "" in

            let store, ctx' = mk_store ctx v in

            let recv_code = mk_bblock

                  { bblockLabel = entry_label;

                    bblockInstrs = Array.of_list

                        (mk_load ctx ch @

                         [mk_normal_call recv_mspec] @

                         store @

                         [I_br q_entry]) } in

            let q_code, ctx'' = gen_proc q q_entry ctx' in

            join_code recv_code q_code, ctx''

 

This is structured fairly similarly to the code for send. Notice how careful we have to be to pass around the right context. mk_store gives an updated context with a new entry for v, but this isn’t the context we pass to mk_load—at that point in the execution, we should still be operating off the bindings in the original context. Using the updated context prematurely would be a problem if the programmer wrote something like x(x).P, where we’re creating a new binding for x and using it before we retrieved the old x from wherever it was first. If we re-used storage we would never run into this problem; nonetheless it always pays to be attentive to what is happening to the context.

 

Like receive, the code for new-name also binds a variable:

 

open Microsoft.AbstractIL.Internal.Bytes

 

 

let rec gen_proc p entry_label ctx =

      match p with

 

      …

 

      | New (v, p) ->

            let p_entry = generate_code_label "" in

            let store, ctx' = mk_store ctx v in

            let new_code = mk_bblock

                  { bblockLabel = entry_label;

                    bblockInstrs = Array.of_list

                        ([I_ldstr (string_as_unicode_bytes v);

                          mk_normal_newobj channel_ctor_mspec] @

                         store @

                         [I_br p_entry])} in

            let p_code, ctx'' = gen_proc p p_entry ctx' in

            join_code new_code p_code, ctx''

 

Now we have to tackle concurrent processes and repetition, both of which are awkward. Let’s dive into concurrent processes first. How do we start a new thread on the CLR? We know how to do it in C#:

 

using System.Threading;

 

static class Program

{

    static void Main()

    {

        Closure closure = new Closure();

        ThreadStart start = new ThreadStart(closure.Run);

        Thread thread = new Thread(start);

        thread.Start();

    }

}

 

class Closure

{

    internal void Run()

    {

        // ...

    }

}

 

Let’s compile that with csc and then dis-assemble the output with ildasm:

 

newobj   instance void Closure::.ctor()

ldftn    instance void Closure::Run()

newobj   instance void

           [mscorlib]System.Threading.ThreadStart::.ctor(

             object,

             native int)

newobj   instance void

           [mscorlib]System.Threading.Thread::.ctor(

             class [mscorlib]System.Threading.ThreadStart)

callvirt instance void [mscorlib]System.Threading.Thread::Start()

 

We can use this code as a template for our own code generation. While we have the metadata in front of us, let’s copy out the type and method specs we will need:

 

let tref_ThreadStart =

      mk_tref (mscorlib_scoref, "System.Threading.ThreadStart")

     

let typ_ThreadStart =

      mk_nongeneric_boxed_typ tref_ThreadStart

     

let mspec_ThreadStart_ctor =

      mk_ctor_mspec_for_typ (typ_ThreadStart, [typ_Object; typ_IntPtr])

 

let tref_Thread =

      mk_tref (mscorlib_scoref, "System.Threading.Thread")

     

let typ_Thread =

      mk_nongeneric_boxed_typ tref_Thread

     

let mspec_Thread_ctor =

      mk_ctor_mspec_for_typ (typ_Thread, [typ_ThreadStart])

 

let mspec_Thread_Start =

      mk_nongeneric_instance_mspec_in_typ (typ_Thread, "Start", [], Type_void)

 

Now we need to instantiate the closure class… But we haven’t defined the closure class yet! That’s ok. Let’s just make up a name for this new type, enter it into the context, and worry about defining the type later:

 

      | Par (p, q) ->

            let p_tref = mk_tref (ScopeRef_local,

                                  generate_code_label "Closure") in

            let ctx' = (fst ctx, snd ctx @ [p, p_tref]) in

            …

 

Next we need to worry about whether p accesses any variables in the context. If it does, we need to communicate those to the new thread. Let’s agree to do it by passing arguments to the constructor of our closure class. When we get around to generating the closure class, we must remember to generate a matching constructor. First we need to examine p and see what, if any, variables it uses. AbsIL comes with a set module called Zset; we can use that to manage sets of variables. Here’s some preamble:

 

open Microsoft.AbstractIL.Internal.Zset

 

 

let var_order (x: id) (y: id) =

      x.CompareTo(y)

 

let empty_vars =

      empty var_order

 

Presumably Zset is using a tree or something that needs ordering over entries. We can just use string comparison. And now we can write empty_vars for the empty set of variables, which is of course the set of variables in the inert (0) process:

 

let rec free_vars p =

      match p with

      | Inert ->

            empty_vars

      …

 

This is a function definition that scrutinizes its argument p, and if p is the inert process, results in the empty set. Now let’s complete the definitions:

 

let rec free_vars p =

      match p with

      | Inert ->

            empty_vars

      | Par (p, q) ->

            union (free_vars p) (free_vars q)

      | Recv (ch, v, p) ->

            add ch (remove v (free_vars p))

      | Send (ch, v, p) ->

            addL [ch; v] (free_vars p)

      | New (v, p) ->

            remove v (free_vars p)

      | Repeat p ->

            free_vars p

 

This is the complete definition of free_vars. We can take any process p, write free_vars p, and get the set of variables we expect to have been stored somewhere before reaching p. Notice how y is not free in x(y).P? That’s because the x(y) binds y to some received value. Nevertheless y is free in P (if y appears in P) because y came into existence outside of P. You will notice that the rule for new is very similar.

 

Now we know which variables p uses, we also know what its constructor will look like:

 

      | Par (p, q) ->

            let p_tref = mk_tref (ScopeRef_local,

                                  generate_code_label "Closure") in

            let ctx' = (fst ctx, (p, p_tref)::snd ctx) in

            let vs = elements (free_vars p) in

            let p_ctor = mk_ctor_mspec_for_nongeneric_boxed_tref

                  (p_tref, List.map (fun _ -> channel_typ) vs) in

            …

 

And we can load those variables, call the constructor, and then start a new thread:

 

            …

            let p_run_mspec = mk_nongeneric_instance_mspec_in_nongeneric_boxed_tref (p_tref, "Run", [], Type_void) in

            let q_entry = generate_code_label "" in

            let p_code = mk_bblock

                  { bblockLabel = entry_label;

                    bblockInstrs = Array.of_list

                        (List.flatten (List.map (mk_load ctx') vs) @

                         [mk_normal_newobj p_ctor_mspec;

                          I_ldftn p_run_mspec;

                          mk_normal_newobj mspec_ThreadStart_ctor;

                          mk_normal_newobj mspec_Thread_ctor;

                          mk_normal_callvirt mspec_Thread_Start;

                          I_br q_entry])} in

            …

 

After we start p and continue with q (there’s no need to start two threads—we’re already executing on one thread and we can just reuse it.) Here’s the code generation for concurrent processes, restated in full:

 

      | Par (p, q) ->

            let p_tref = mk_tref (ScopeRef_local,

                                            generate_code_label "Closure") in

            let ctx' = (fst ctx, (p, p_tref)::snd ctx) in

            let vs = elements (free_vars p) in

            let p_ctor_mspec = mk_ctor_mspec_for_nongeneric_boxed_tref

                  (p_tref, List.map (fun _ -> channel_typ) vs) in

            let p_run_mspec = mk_nongeneric_instance_mspec_in_nongeneric_boxed_tref (p_tref, "Run", [], Type_void) in

            let q_entry = generate_code_label "" in

            let p_code = mk_bblock

                  { bblockLabel = entry_label;

                    bblockInstrs = Array.of_list

                        (List.flatten (List.map (mk_load ctx') vs) @

                         [mk_normal_newobj p_ctor_mspec;

                          I_ldftn p_run_mspec;

                          mk_normal_newobj mspec_ThreadStart_ctor;

                          mk_normal_newobj mspec_Thread_ctor;

                          mk_normal_callvirt mspec_Thread_Start;

                          I_br q_entry])} in

            let q_code, ctx'' = gen_proc q q_entry ctx' in

            join_code p_code q_code, ctx''

 

We’ve left the trickiest thing to compile, repetition with !P, until last. Repetition is the most difficult thing to compile because its semantics are so far away from what the computer really does. !P means an infinite number of Ps, running concurrently; the computer is a machine with limited processing and memory resources. We shall quickly exhaust those resources if we reach for something familiar, like using loop to spawn concurrent processes. We have to simulate having an infinite number of Ps.

 

While the semantics of !P is making our life difficult, the semantics also offers us a way out. Let’s stop to make a few observations about how process work under the !. First, if we have a ! outside concurrent processes, it’s the same as concurrently having the ! over those processes directly:

 

            !(P | Q)            =          (P | Q) | !(P | Q)          = !P | !Q

 

All of these terms generate the same thing: P | P | P … | Q | Q | Q … If it makes our life any easier, we can happily float ! inside or outside sets of concurrent processes without affecting the meaning of the program.

 

If we happened to float a ! against a process that was already repeated? Two !s mean the same as one:

 

            !!P                   =          !P

 

If we always float the ! into concurrent processes, and replace adjacent !s with a single !, we end up with the situation where all !s are followed by a send, a receive, a new, or the inert process.

 

The inert process case is really easy—!0 does nothing, so we can just replace it with 0.

 

We’re left with the send, receive and new cases. Recall that send and receive wait until the message is sent or received:

 

!x(y).P                         =          x(y).(P | !x(y).P)

 

This looks as though we’re going in circles—the term is more complex and we’ve still got !x(y).P to contend with! Fortunately this recursive definition of !x(y).P is much more friendly to the computer, because it waits to receive on x before it waits to receive on x a second (and a third, and an umpteenth time.)

 

How do we implement this? The first thing we need to do is rewrite our processes into the form where every ! is followed by a send/receive/new, and oddities like !0 are translated away. F# excels at this sort of thing:

 

let rec desugar_proc p =

      match p with

      | Inert ->

            p

      | Send (ch, v, q) ->

            Send (ch, v, desugar_proc q)

      | Recv (ch, v, q) ->

            Recv (ch, v, desugar_proc q)

      | New (v, q) ->

            New (v, desugar_proc q)

      | Par (Inert, q) ->

            desugar_proc q

      | Par (p, Inert) ->

            desugar_proc p

      | Par (p, q) ->

            Par (desugar_proc p, desugar_proc q)

      | Repeat Inert ->

            Inert

      | Repeat (Repeat p) ->

            desugar_proc (Repeat p)

      | Repeat (Par (p, q)) ->

            Par (desugar_proc (Repeat p), desugar_proc (Repeat q))

      | Repeat p ->

            Repeat (desugar_proc p)

 

let canon_proc p =

      (* we need to keep running desugar_proc until it reaches a fixed

         point *)

      let rec f u v =

            if u = v then

                  u

            else

                  f v (desugar_proc v)

      in

      f p (desugar_proc p)

 

This first part, desugar_proc, does the basic re-writing steps we outlined above. canon_proc keeps desugaring until there’s no sweetness left—only our simplified canonical form.

 

Back to our recursive definition of !. After a send/receive/new, we need to start the body of the repetition running concurrently and do the next send/receive/new. We’ve already written the code for starting a process concurrently in the code-generation branch for Par. Can we just reuse that instead of writing it again?

 

      | Repeat p ->

            (match p with

            | Inert

            | Par _

            | Repeat _ ->

                  failwith "gen_proc: gen_proc of non-canonical process"

            | Send (ch, v, q) ->

                  let p' = Send (ch, v, Par (q, ???)) in

                  gen_proc p' entry_label ctx

            | Recv (ch, v, q) ->

                  let p' = Recv (ch, v, Par (q, ???)) in

                  gen_proc p' entry_label ctx

            | New (v, q) ->

                  let p' = New (v, Par (q, ???)) in

                  gen_proc p' entry_label ctx)

 

It looks as though we almost can. First we check that we’re working on a process which has been through canon_proc. If we see something we’re not expecting we fail with an error. But what about those holes where we want to do the recursion? At the IL-level, all we need to do is jump to the beginning of the send/receive/new to do it again. It’s pretty expedient just to stick another term in the abstract syntax:

 

open Microsoft.AbstractIL.IL

 

type id = string

 

type proc =

      | Inert

      | Par of proc * proc

      | Recv of id * id * proc

      | Send of id * id * proc

      | New of id * proc

      | Repeat of proc

      | Branch of code_label

 

All of our existing functions now need to work with this new Branch case, but because they should expect to work on just the traditional calculus terms, we can add failure clauses like:

 

let rec free_vars p =

      match p with

      | Inert ->

            empty_vars

      | …

      | Repeat p ->

            free_vars p

      | Branch _ ->

            failwith "free_vars: free_vars of branch"

 

And we can complete gen_proc:

 

      | Repeat p ->

            let loop_entry = generate_code_label "" in

            (match p with

            | Inert

            | Par _

            | Repeat _ ->

                  failwith "gen_proc: gen_proc of non-canonical process"

            | Branch _ ->

                  failwith "gen_proc: encountered repeat-branch"

            | Send (ch, v, q) ->

                  let p' = Send (ch, v, Par (q, Branch entry_label)) in

                  gen_proc p' entry_label ctx

            | Recv (ch, v, q) ->

                  let p' = Recv (ch, v, Par (q, Branch entry_label)) in

                  gen_proc p' entry_label ctx

            | New (v, q) ->

                  let p' = New (v, Par (q, Branch entry_label)) in

                  gen_proc p' entry_label ctx)

      | Branch label ->

            mk_bblock

                  { bblockLabel = entry_label;

                    bblockInstrs = [| I_br label |] },

            ctx

 

Now we need to tie these IL instructions into a method in a class. Let’s call this function gen_closure. It needs a process to generate the code for, the name of the type to put the code in—we’ll carry that around in a type ref, since we’re already using type refs with the code generation for Par—and it should construct a type definition.

 

We know gen_proc generates code, and two sets of mappings: variables to where those variables are stored, and processes to type refs, which we use to start processes concurrently in Par. Since gen_closure is going to rely heavily on gen_proc, we will be getting those mappings too. We can throw away the variable mapping—that really only applies to the process we’re generating a closure for. However the process to type ref mapping is important because it guides which processes we have to generate closures for. I suspect we’ll have to return the process to type ref mapping back to whatever drives gen_closure. Our context at the gen_closure level is the type definitions we’ll generate and the process to type ref mappings gen_proc we discover along the way:

 

let gen_closure p tref (tdefs, trefs) =

    …

 

A CLR type definition consists of a name; various bits of metadata like what kind of type it is (such as a delegate, or an enumeration, or a class); fields; methods; properties; events; nested types; custom attributes; and so on. We only need the first three or four things: a name, some sensible metadata (for example, that we’re generating a class); fields for free variables; a constructor and a Run method (remember the code generation for Par relies on a constructor and a Run method.)

 

Let’s start with the fields. There’s one for each free variable in the process:

 

let gen_closure p tref (tdefs, trefs) =

      let typ = mk_nongeneric_boxed_typ tref in

     

      (* fields for captured variables *)

      let vs = elements (free_vars p) in

      let fss = List.map (fun v -> mk_fspec_in_typ (typ, v, channel_typ)) vs in

      let store = List.map2 (fun v f -> v, Field f) vs fss in

      let fds = List.map (fun v -> mk_instance_fdef (v, channel_typ, None, MemAccess_private)) vs in

      …

 

This finds the free variables, just as we did for starting a concurrent process with Par, constructs type specs for them, makes a map from variable to field storage called store, and then makes a list of field definitions. Field definitions are pretty simple: mk_instance_fdef takes a field name (we’re just using the variable name); the type of the field (Channel, as always for us); and a protection level—we’re encapsulating the field by making it private.

 

Now let’s define a constructor. The constructor needs to shunt its arguments into the fields we just defined:

 

      (* constructor *)

      let ctor_params = List.map (fun v -> mk_param (Some v, channel_typ)) vs in

      let ctor_entry = generate_code_label "" in

      let n = ref 0 in

      let ctor_code = nonbranching_instrs_then_ret ctor_entry (List.flatten

            ([I_ldarg (int_to_u16 0);

              mk_normal_call (mk_nongeneric_instance_mspec_in_typ (typ_Object, ".ctor", [], Type_void))] ::

             List.map (fun f ->

                  incr n;

                  [I_ldarg (int_to_u16 0);

                   I_ldarg (int_to_u16 !n);

                   mk_normal_stfld f]

                          ) fss)) in

      let ctor_body = mk_ilmbody (true, [], 2, ctor_code, None) in

      let ctor_mdef = mk_ctor (MemAccess_public, ctor_params, MethodBody_il ctor_body) in

 

This is our first full method definition with AbsIL. There’s the familiar IL code generation, which we’ve already seen a lot of in gen_proc, but beside that the IL is wrapped in a method body; there is a list of parameters; a protection level (public), and so on.

 

The last thing we need to generate is a Run method:

 

      (* run method *)

      let run_entry = generate_code_label "" in

      let run_code, ctx = gen_proc p run_entry (store, trefs) in

      let run_body = mk_ilmbody (

            true,

            List.map (fun _ -> mk_local channel_typ) (locals_of_context ctx),

            2,

            run_code,

            None) in

      let run_mdef = mk_instance_mdef ("Run", MemAccess_public, [], Type_void, MethodBody_il run_body) in

 

That was surprisingly easy. We construct a context with the field specs we made up (store) and whatever type refs we were passed; gen_proc does the real work. Now to wrap it all up in a type definition:

 

      (* type definition *)

      let tdef =

            { tdKind = TypeDef_class;

              tdName = tname_of_tref tref;

              tdGenericParams = [];

              tdAccess = TypeAccess_public;

              tdAbstract = false;

              tdSealed = true;

              tdSerializable = false;

              tdComInterop = false;

              tdLayout = TypeLayout_auto;

              tdSpecialName = false;

              tdEncoding = TypeEncoding_autochar;

              tdNested = mk_tdefs [];

              tdImplements = [];

              tdExtends = Some typ_Object;

              tdMethodDefs = mk_mdefs [ctor_mdef; run_mdef];

              tdSecurityDecls = mk_security_decls [];

              tdHasSecurity = false;

              tdFieldDefs = mk_fdefs fds;

              tdMethodImpls = mk_mimpls [];

              tdInitSemantics = TypeInit_beforefield;

              tdEvents = mk_events [];

              tdProperties = mk_properties [];

              tdCustomAttrs = mk_custom_attrs [] } in

             

      tdef :: tdefs, snd ctx

 

Type definitions are certainly verbose, but there’s nothing difficult there. We’re defining a class, we use the name we were passed in, and its empty except for our field definitions, constructor, and Run method.

 

That’s fine for generating one closure. How do we generate all the closures? I guess we start with a single process:

 

let gen_closures p =

    …

 

Now we’re going to use gen_closure, and since it is adding to the process-to-type ref mapping via gen_proc, we’re going to need to loop over the mapping and keep calling gen_closure until there’s no more closures to generate:

 

let gen_closures p =

      let rec f (tdefs, trefs) =

            match trefs with

            | [] ->

                  tdefs

            | (q, tref)::trefs' ->

                  f (gen_closure q tref (tdefs, trefs'))

      in

      f ([], [p, mk_tref (ScopeRef_local, "Main")])

 

This looks a little hairy, but it’s a very similar shape to canon_proc which we wrote earlier. To kick things off we create a type ref called Main for the top-level process and start generating there. We should end up with a list of type defs. More on getting those type defs into a .NET module next time.

Powered by Google App Engine
Custom Search