Example of a fizzbuzz specific AST that emits LLVM bytecode that can be run through clang

FizzBuzzLLVM.fs

module AST = 

    type Name = string
    type TypeName = string
    
    type Literal = Int of int | Bool of bool | String of string | Void
    
    type Expr = 
    | Literal of Literal
    | Rem of Expr * Expr
    | Add of Expr * Expr
    | Equal of Expr * Expr
    | Assign of Name * Expr
    | Local of Name
    | Call of Name * Expr list
    | If of Expr * Expr * Expr
    | Return of Expr
    
    
    type Function = 
        { 
            Name : Name 
            Parameters : (Name * TypeName) list  
            ReturnType : TypeName 
            Body : Expr list
        }
    
    type Type = 
        {
            Name : Name 
            Parameters : (Name * TypeName) list  
        } 

    type Body = 
    | Type of Type
    | Function of Function

module ExternalFunctions = 
    open LLVMSharp

    let printf mod' = 
        let printfTy = LLVM.FunctionType(LLVM.Int32Type(), [|LLVM.PointerType(LLVM.Int8Type(), 0u)|] , true)
        let printf =  LLVM.AddFunction(mod', "printf", printfTy) 
        LLVM.SetLinkage(printf, LLVMLinkage.LLVMExternalLinkage)  
        printf

module LLVMBackend = 
    open LLVMSharp
    open System
    open AST
    
    let private toType = function
        | "Int" -> LLVM.Int32Type()
        | "Bool" -> LLVM.Int1Type()
        | _ -> failwith "Unknown Type"
    
    let private buildFunctionHeader 
                    mod'  
                    { Name = functionName
                      Parameters = parameters 
                      ReturnType = returnType
                      Body = exprs} = 
            let parametersMap = parameters |> List.mapi (fun i (name, _) -> name,i) 
            let parameters = parameters |> List.map snd |> List.map toType
            let functionSignature = LLVM.FunctionType(toType returnType, parameters |> List.toArray, false)
            let function' = LLVM.AddFunction(mod', functionName, functionSignature)
            functionName, function', parametersMap, returnType, exprs
    
    let private buildFunctionBody builder function' (parameters:(Name * int) list) exprs functionLookup = 
        let entry = LLVM.AppendBasicBlock(function', "") 
        LLVM.PositionBuilderAtEnd(builder, entry)
        
        let parameters = parameters |> List.map(fun (name, index) -> name, function'.GetParam(uint32 <| index)) |> Map.ofList
    
        let rec eval expr (locals:Map<Name, LLVMValueRef>) = 
            match expr with
            | Literal (Int(value)) -> 
                let result = LLVM.ConstInt(LLVM.Int32Type(), uint64 value, LLVMBool 0)
                Some result, locals
            | Literal (Bool(value)) -> 
                let value = if value then uint64 1 else uint64 0
                let result = LLVM.ConstInt(LLVM.Int1Type(), value, LLVMBool 0)
                Some result, locals
            | Literal (Void) -> 
                let result = LLVM.BuildRetVoid(builder)
                Some result, locals
            | Literal(String value) -> 
                let result = LLVM.BuildGlobalStringPtr(builder, value, "")
                Some result, locals
            | Equal(lhs, rhs) ->
                let (lhs, locals) = eval lhs locals
                let (rhs, locals) = eval rhs locals
                let result = 
                    match lhs, rhs with
                    | Some(lhs), Some(rhs) -> LLVM.BuildICmp(builder, LLVMIntPredicate.LLVMIntEQ, lhs, rhs, "") |> Some
                    | _ -> None
                result, locals
            | Rem(lhs, rhs) ->
                let (lhs, locals) = eval lhs locals
                let (rhs, locals) = eval rhs locals
                let result = 
                    match lhs, rhs with
                    | Some(lhs), Some(rhs) -> LLVM.BuildSRem(builder, lhs, rhs, "") |> Some
                    | _ -> None
                result, locals
            | Add(lhs, rhs) ->
                let (lhs, _) = eval lhs locals
                let (rhs, _) = eval rhs locals
                let result = 
                    match lhs, rhs with
                    | Some(lhs), Some(rhs) -> LLVM.BuildAdd(builder, lhs, rhs, "") |> Some
                    | _ -> None
                result, locals
            | Assign(name, expr) ->
                let (rhs, locals) = eval expr locals
                match rhs with
                | Some rhs -> Some rhs, locals |> Map.add name rhs
                | None -> None, locals
            | Local(name) -> 
                locals |> Map.tryFind name, locals
            | Call(funcName, parameters) ->
                let function' = functionLookup |> Map.find funcName
                let (parameters, locals) = 
                    parameters 
                    |> List.fold(
                        fun (acc, locals) n -> 
                            let (next, locals) = eval n locals
                            acc @ [next], locals
                       ) ([], locals)
                let parametersx = parameters |> List.choose id |> List.toArray
                let result = LLVM.BuildCall(builder, function', parametersx, "")
                Some(result), locals
            | If(expr, trueExpr, falseExpr) -> 
                let (expr, locals) = eval expr locals
                
                let result = 
                    match expr with
                    | Some(expr) ->
                        let func = LLVM.GetBasicBlockParent(LLVM.GetInsertBlock(builder))
    
                        let thenBlock = LLVM.AppendBasicBlock(func, "")
                        let elseBlock = LLVM.AppendBasicBlock(func, "")
                        let continue' = LLVM.AppendBasicBlock(func, "")
                        let result = LLVM.BuildCondBr(builder, expr, thenBlock, elseBlock)
                        LLVM.PositionBuilderAtEnd(builder, thenBlock)
                        let (Some(thenV), _) = eval trueExpr locals
                        LLVM.BuildBr(builder, continue') |> ignore
                        let thenBlock = LLVM.GetInsertBlock(builder)
                        LLVM.PositionBuilderAtEnd(builder, elseBlock);
                        let (Some(elseV), _) = eval falseExpr locals
                        let buildBr = LLVM.BuildBr(builder, continue') 
                        let elseBlock = LLVM.GetInsertBlock(builder)
                        LLVM.PositionBuilderAtEnd(builder, continue')
                        let phi = LLVM.BuildPhi(builder, LLVM.TypeOf(thenV), "")
                        LLVM.AddIncoming(phi, [|thenV|], [|thenBlock|], 1u)
                        LLVM.AddIncoming(phi, [|elseV|], [|elseBlock|], 1u)
                        elseV |> Some
                    | _ -> None
                result, locals 
            | Return(expr) -> 
                let (ret, locals) = eval expr locals
                let result = 
                    match ret with 
                    | Some(ret) -> LLVM.BuildRet(builder, ret) |> Some
                    | None -> None
                result, locals
        exprs |> List.fold(fun locals expr  -> eval expr (snd locals)) (None, parameters)
        

    let build moduleName ast = 
        let mod' = LLVM.ModuleCreateWithName moduleName
        let builder = LLVM.CreateBuilder()    
        let printf = ExternalFunctions.printf mod'
        let functionsList = ast |> List.choose (function Function f -> Some f | _ -> None)|> List.map (fun f -> buildFunctionHeader mod' f) 
        let functionsMap = functionsList |> List.map(fun (name, function', _, _,_) -> name, function') |> Map.ofList
        let functionsMap = functionsMap |> Map.add "printf" printf
    
        functionsList 
        |> List.iter 
            (fun (_, function', parameters, _, exprs) ->
                buildFunctionBody builder function' parameters exprs functionsMap |> ignore
            )
            
        let mutable error = String.Empty
        LLVM.VerifyModule(mod', LLVMVerifierFailureAction.LLVMPrintMessageAction, &error) |> ignore
        printfn "Error : %s" error
        
        LLVM.LinkInMCJIT()
            
        LLVM.WriteBitcodeToFile(mod', moduleName + ".bc") |> ignore
    
        LLVM.DumpModule mod'
        LLVM.DisposeBuilder builder
   
open AST

let ast = 
    [ Body.Function(
        { Name = "FizzBuzz"
          Parameters = ["Current", "Int"; "Maximum", "Int" ]
          ReturnType = "Int"
          Body = 
            [
                If(
                    Equal(
                         Rem(Local "Current", Literal(Int 15)), 
                         Literal (Int 0)),
                    Call("printf", [Literal(String "FIZZBUZZ\n")]), 
                    If(
                        Equal(
                            Rem(Local "Current", Literal(Int 5)), 
                            Literal(Int 0)),
                        Call("printf", [Literal(String "BUZZ\n")]),
                        If(
                            Equal(
                                Rem(Local "Current", Literal(Int 3)), 
                                Literal(Int 0)),
                            Call("printf", [Literal(String "FIZZ\n")]),
                            Call("printf", [Literal(String "%d\n"); Local "Current"]))))
                
                
                Assign("IncCurrent", Add(Local "Current", Literal(Int 1)))
                If(Equal(Local "IncCurrent", Local "Maximum"),
                   Literal(Int 1),
                   Call("FizzBuzz", [Local "IncCurrent"; Local "Maximum"]))
                Return (Literal(Int 0))
            ]
         })
      Body.Function(
        { Name = "main"
          Parameters = []
          ReturnType = "Int"
          Body = 
            [ 
                Call("FizzBuzz",  [Literal(Int 1); Literal(Int 100)])
                Return(Literal(Int(0))) ]
        })
    ]


do  
    LLVMBackend.build "Module" ast

System.Console.ReadLine() |> ignore