Using LLVM from F# under Windows

LLVM is an awesome low-level virtual machine that provides excellent code generators for all major architectures including x86, x64 and ARM but it is used primarily under Linux and Mac OS X and not Windows. This blog post describes how to install LLVM and its dependencies under Windows and use F# to write a mini-compiler capable of JIT compiling and executing the Fibonacci function.

Installation

• Download and install Python 2.7 x86 Windows MSI installer.
• Download and install MinGW mingw-get-inst.exe.
• Download the LLVM 3.0 sources to C:\MinGW\msys\1.0\home\Jon\llvm-3.0.tar.gz
• Run the MinGW shell (use Start menu's search to find it):

1. export PATH=$PATH:/c/Python27/
2. gunzip <llvm-3.0.tar.gz | tar xv llvm-3.0.tar.gz
3. cd llvm-3.0.src
4. ./configure --enable-shared --enable-jit --enable-bindings=none
5. make

• Add the C:\MinGW\msys\1.0\home\Jon\llvm-3.0.src\Release\bin\ directory to the Windows PATH via Start Menu → Computer (Right click) → Advanced system settings → Environment variables.
• Restart Visual Studio 2010
• Create a new solution and add Keith Sheppard's llvm-fs project to it.

Now we're ready to start writing F# code that calls out to LLVM via PInvoke in order to get code JIT compiled and executed.

A first compiler
The following F# program contains an expression and function compiler that can compile and execute a variety of self-recursive functions:


open LLVM.Generated.Core
open LLVM.Core
open LLVM.Generated.ExecutionEngine
open LLVM.ExecutionEngine

type Type =
  | TBool
  | TInt
  | TFunction of Type list * Type

  member ty.LLVM =
    match ty with
    | TBool -> int8Type()
    | TInt -> int32Type()
    | TFunction(argTys, retTy) ->
        functionType retTy.LLVM [|for ty in argTys -> ty.LLVM|]

type State =
  {
    Find: string -> ValueRef * Type
    Builder: BuilderRef
    Blk: BasicBlockRef
    Function: ValueRef
  }

  member state.AppendBasicBlock() =
    appendBasicBlock state.Function ""

  member state.MoveTo blk =
    positionBuilderAtEnd state.Builder blk
    { state with Blk = blk }

type BinOp = Add | Leq

type Expr =
  | EInt of int
  | EVar of string
  | EBinOp of BinOp * Expr * Expr
  | EIf of Expr * Expr * Expr
  | EApply of Expr * Expr list
  | EReturn of Expr

  static member (+) (f, g) = EBinOp(Add, f, g)
  static member (<=.) (f, g) = EBinOp(Leq, f, g)

let find state s =
  match Map.tryFind s state with
  | Some v -> v
  | None -> failwithf "Unknown variable '%s'" s

let rec cont state f kBlk =
  let f, state = compileExpr state f
  let _ = buildBr state.Builder kBlk
  f, state
and compileExpr state expr =
  match expr with
  | EReturn f ->
      let (f, fTy), state = compileExpr state f
      (buildRet state.Builder f, fTy), state
  | EInt n -> (constInt (int32Type()) (uint64 n) false, TInt), state
  | EVar s -> state.Find s, state
  | EBinOp(op, f, g) ->
      let (f, fTy), (g, gTy), state = compileExpr2 state f g
      match op, fTy, gTy with
      | Add, TInt, TInt -> (buildAdd state.Builder f g "", TInt), state
      | Leq, TInt, TInt -> (buildICmp state.Builder IntPredicate.IntSLE f g "", TBool), state
      | _ -> failwith "Type error"
  | EIf(p, t, f) ->
      let tBlk = state.AppendBasicBlock()
      let fBlk = state.AppendBasicBlock()
      let kBlk = state.AppendBasicBlock()
      let (p, pTy), state = compileExpr state p
      if pTy <> TBool then failwith "Type error"
      let _ = buildCondBr state.Builder p tBlk fBlk
      let (t, tTy), state = cont (state.MoveTo tBlk) t kBlk
      let (f, fTy), state = cont (state.MoveTo fBlk) f kBlk
      if tTy <> fTy then failwith "Type error"
      let state = state.MoveTo kBlk
      let phi = buildPhi state.Builder (tTy: Type).LLVM ""
      addIncoming phi [|t, tBlk; f, fBlk|]
      (phi, tTy), state
  | EApply(f, xs) ->
      let (f, fTy), state = compileExpr state f
      let xs, state = compileExprs state xs
      match fTy with
      | TFunction(argTys, retTy) when argTys = List.map snd xs ->
          (buildCall state.Builder f [|for x, _ in xs -> x|] "", retTy), state
      | _ -> failwith "Type error"
and compileExpr2 state f g =
  let f, state = compileExpr state f
  let g, state = compileExpr state g
  f, g, state
and compileExprs state = function
  | [] -> [], state
  | f::fs ->
      let f, state = compileExpr state f
      let fs, state = compileExprs state fs
      f::fs, state  

let compileFn m name (args: (string * Type) list) body (retTy: Type) =
  let funcType = functionType retTy.LLVM [|for _, ty in args -> ty.LLVM|]
  let fn = addFunction m name funcType
  let bldr = new Builder ()
  let find x =
    List.mapi (fun i x -> i, x) args
    |> Seq.pick (fun (i, (k, ty)) -> if k=x then Some(getParam fn (uint32 i), ty) else None)
  let find x = if x=name then (fn, TFunction(List.map snd args, retTy)) else find x
  let state =
    {
      Find = find
      Builder = bldr
      Blk = appendBasicBlock fn ""
      Function = fn
    }
  positionBuilderAtEnd bldr state.Blk
  let (_, retTy'), state = compileExpr state (EReturn body)
  if retTy <> retTy' then failwith "Type error"
  fn

open System.Runtime.InteropServices

[<DllImport("LLVM-3.0.dll", EntryPoint="LLVMInitializeX86Target")>]
extern void initializeX86Target()

do
  initializeX86Target ()
  let myModule = moduleCreateWithName "addModule"
  let ee = createExecutionEngineForModule myModule
  let inline mkInt n = createGenericValueOfInt (int32Type()) (uint64 n) false

  let add = compileFn myModule "add" ["m", TInt; "n", TInt] (EVar "m" + EVar "n") TInt
  let result = runFunction ee add [|mkInt 3; mkInt 8|]
  printfn "3 + 8 = %d" (genericValueToInt result false)

  let sign =
    compileFn myModule "sign"
      ["n", TInt]
      (EIf(EVar "n" <=. EInt 0, EInt -1, EInt 1))
      TInt
  let result = runFunction ee sign [|mkInt 3|]
  printfn "sign 3 = %d" (genericValueToInt result false)

  let fib =
    compileFn myModule "fib"
      ["n", TInt]
      (EIf(EVar "n" <=. EInt 1, EVar "n",
          EApply(EVar "fib", [EVar "n" + EInt -1]) +
            EApply(EVar "fib", [EVar "n" + EInt -2])))
      TInt
  let result = runFunction ee fib [|mkInt 10|]
  printfn "fib 10 = %d" (genericValueToInt result false)

As of writing, an unknown bug (probably in llvm-fs) causes Visual Studio 2010 to stop with an error about unbalanced stacks every time an LLVM function is invoked. We have tried each calling convention and they all give this error.