2 people like it.

Simple F# Expression to Java compiler

Compiles simple F# quoted expressions (literals, values, operators, ifs and for loops) to Java code.

  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: 
 83: 
 84: 
 85: 
 86: 
 87: 
 88: 
 89: 
 90: 
 91: 
 92: 
 93: 
 94: 
 95: 
 96: 
 97: 
 98: 
 99: 
100: 
101: 
102: 
103: 
104: 

open Microsoft.FSharp.Quotations
open Microsoft.FSharp.Quotations.Patterns
open Microsoft.FSharp.Quotations.DerivedPatterns

let notImplemented () = raise (System.NotImplementedException())

let toTypeName  t =
    if t = typeof<int> then "int"
    elif t = typeof<double> then "double" 
    elif t = typeof<bool> then "boolean"
    else notImplemented()

let name =
    let x = ref 0
    fun () -> incr x; sprintf "_%d" !x

let rec toJava (add:string -> unit) = function
   | Let(var, expr, body) -> toLet add var expr body
   | Var(var) -> sprintf "%s" var.Name
   | VarSet(var, expr) -> toAssign add var expr
   | Int32 x -> sprintf "%i" x
   | Double x -> sprintf "%gd" x
   | Bool true -> "true"
   | Bool false -> "false"
   | SpecificCall <@@ (+) @@> (None, _, [lhs;rhs]) -> toArithOp add "+" lhs rhs
   | SpecificCall <@@ (-) @@> (None, _, [lhs;rhs]) -> toArithOp add "-" lhs rhs
   | SpecificCall <@@ (*) @@> (None, _, [lhs;rhs]) -> toArithOp add "*" lhs rhs
   | SpecificCall <@@ (/) @@> (None, _, [lhs;rhs]) -> toArithOp add "/" lhs rhs
   | SpecificCall <@@ (=) @@> (None, _, [lhs;rhs]) -> toLogicOp add "==" lhs rhs
   | SpecificCall <@@ (<>) @@> (None, _, [lhs;rhs]) -> toLogicOp add "!=" lhs rhs
   | IfThenElse(condition, t, f) -> toIfThenElse add condition t f
   | Sequential(lhs,rhs) -> toSequential add lhs rhs
   | ForIntegerRangeLoop(var,Int32 a,Int32 b,body) -> toForLoop add var a b body
   | _ -> notImplemented()
and toLet add var expr body =
    let valueName = toJava add expr
    add <| sprintf "%s %s = %s;" (toTypeName var.Type) var.Name valueName
    toJava add body
and toAssign add var expr =
    let value = toJava add expr
    add <| sprintf "%s = %s;" var.Name value
    ""
and toArithOp add op lhs rhs =
    let l,r = (toJava add lhs), (toJava add rhs)
    let name = name ()
    add <| sprintf "%s %s = (%s %s %s);" (toTypeName lhs.Type) name l op r
    name
and toLogicOp add op lhs rhs =
    let l,r = (toJava add lhs), (toJava add rhs)
    let name = name ()
    add <| sprintf "boolean %s = (%s %s %s);" name l op r
    name
and toIfThenElse add condition t f =
    let cn, tn, fn = toJava add condition, toJava add t, toJava add f
    let name = name ()
    add <| sprintf "%s %s = %s ? %s : %s;" (toTypeName t.Type) name cn tn fn
    name
and toSequential add lhs rhs =    
    toJava add lhs |> ignore
    toJava add rhs
and toForLoop add var a b body =
    let s = System.Text.StringBuilder()
    let localAdd (x:string) = s.Append(x) |> ignore
    toJava localAdd body |> ignore
    let i = var.Name
    add <| sprintf "for(int %s = %d; %s <= %d; %s++) { %s }" i a i b i (s.ToString())
    ""

let toClass (expr:Expr<'TRet>) =
    let t = typeof<'TRet>
    if t = typeof<unit> then notImplemented()
    let returnType = toTypeName t
    let s = System.Text.StringBuilder()
    let add x = s.AppendLine("    " + x) |> ignore
    let v = toJava add expr
    sprintf """
public class Generated {
  public static %s fun(){
%s    return %s;
  }
  public static void main(String []args){
    System.out.println(fun());
  }
}"""  returnType (s.ToString()) v

toClass 
 <@ let mutable fac = 1
    for i = 1 to 6 do fac <- fac * i
    fac @>

(*Returns

public class Generated {
  public static int fun(){
    int fac = 1;
    for(int i = 1; i <= 6; i++) { int _1 = (fac * i);fac = _1; }
    return fac;
  }
  public static void main(String []args){
    System.out.println(fun());
  }
}

*)
namespace Microsoft
namespace Microsoft.FSharp
namespace Microsoft.FSharp.Quotations
module Patterns

from Microsoft.FSharp.Quotations
module DerivedPatterns

from Microsoft.FSharp.Quotations
val notImplemented : unit -> 'a

Full name: Script.notImplemented
val raise : exn:System.Exception -> 'T

Full name: Microsoft.FSharp.Core.Operators.raise
namespace System
Multiple items
type NotImplementedException =
  inherit SystemException
  new : unit -> NotImplementedException + 2 overloads

Full name: System.NotImplementedException

--------------------
System.NotImplementedException() : unit
System.NotImplementedException(message: string) : unit
System.NotImplementedException(message: string, inner: exn) : unit
val toTypeName : t:System.Type -> string

Full name: Script.toTypeName
val t : System.Type
val typeof<'T> : System.Type

Full name: Microsoft.FSharp.Core.Operators.typeof
Multiple items
val int : value:'T -> int (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.int

--------------------
type int = int32

Full name: Microsoft.FSharp.Core.int

--------------------
type int<'Measure> = int

Full name: Microsoft.FSharp.Core.int<_>
Multiple items
val double : value:'T -> float (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.double

--------------------
type double = System.Double

Full name: Microsoft.FSharp.Core.double
type bool = System.Boolean

Full name: Microsoft.FSharp.Core.bool
val name : (unit -> string)

Full name: Script.name
val x : int ref
Multiple items
val ref : value:'T -> 'T ref

Full name: Microsoft.FSharp.Core.Operators.ref

--------------------
type 'T ref = Ref<'T>

Full name: Microsoft.FSharp.Core.ref<_>
val incr : cell:int ref -> unit

Full name: Microsoft.FSharp.Core.Operators.incr
val sprintf : format:Printf.StringFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.sprintf
val toJava : add:(string -> unit) -> _arg1:Expr -> string

Full name: Script.toJava
val add : (string -> unit)
Multiple items
val string : value:'T -> string

Full name: Microsoft.FSharp.Core.Operators.string

--------------------
type string = System.String

Full name: Microsoft.FSharp.Core.string
type unit = Unit

Full name: Microsoft.FSharp.Core.unit
active recognizer Let: Expr -> (Var * Expr * Expr) option

Full name: Microsoft.FSharp.Quotations.Patterns.( |Let|_| )
val var : Var
val expr : Expr
val body : Expr
val toLet : add:(string -> unit) -> var:Var -> expr:Expr -> body:Expr -> string

Full name: Script.toLet
Multiple items
active recognizer Var: Expr -> Var option

Full name: Microsoft.FSharp.Quotations.Patterns.( |Var|_| )

--------------------
type Var =
  interface IComparable
  new : name:string * typ:Type * ?isMutable:bool -> Var
  member IsMutable : bool
  member Name : string
  member Type : Type
  static member Global : name:string * typ:Type -> Var

Full name: Microsoft.FSharp.Quotations.Var

--------------------
new : name:string * typ:System.Type * ?isMutable:bool -> Var
property Var.Name: string
active recognizer VarSet: Expr -> (Var * Expr) option

Full name: Microsoft.FSharp.Quotations.Patterns.( |VarSet|_| )
val toAssign : add:(string -> unit) -> var:Var -> expr:Expr -> string

Full name: Script.toAssign
active recognizer Int32: Expr -> int32 option

Full name: Microsoft.FSharp.Quotations.DerivedPatterns.( |Int32|_| )
val x : int32
active recognizer Double: Expr -> float option

Full name: Microsoft.FSharp.Quotations.DerivedPatterns.( |Double|_| )
val x : float
active recognizer Bool: Expr -> bool option

Full name: Microsoft.FSharp.Quotations.DerivedPatterns.( |Bool|_| )
active recognizer SpecificCall: Expr -> Expr -> (Expr option * System.Type list * Expr list) option

Full name: Microsoft.FSharp.Quotations.DerivedPatterns.( |SpecificCall|_| )
union case Option.None: Option<'T>
val lhs : Expr
val rhs : Expr
val toArithOp : add:(string -> unit) -> op:string -> lhs:Expr -> rhs:Expr -> string

Full name: Script.toArithOp
val toLogicOp : add:(string -> unit) -> op:string -> lhs:Expr -> rhs:Expr -> string

Full name: Script.toLogicOp
active recognizer IfThenElse: Expr -> (Expr * Expr * Expr) option

Full name: Microsoft.FSharp.Quotations.Patterns.( |IfThenElse|_| )
val condition : Expr
val t : Expr
val f : Expr
val toIfThenElse : add:(string -> unit) -> condition:Expr -> t:Expr -> f:Expr -> string

Full name: Script.toIfThenElse
active recognizer Sequential: Expr -> (Expr * Expr) option

Full name: Microsoft.FSharp.Quotations.Patterns.( |Sequential|_| )
val toSequential : add:(string -> unit) -> lhs:Expr -> rhs:Expr -> string

Full name: Script.toSequential
active recognizer ForIntegerRangeLoop: Expr -> (Var * Expr * Expr * Expr) option

Full name: Microsoft.FSharp.Quotations.Patterns.( |ForIntegerRangeLoop|_| )
val a : int32
val b : int32
val toForLoop : add:(string -> unit) -> var:Var -> a:int32 -> b:int32 -> body:Expr -> string

Full name: Script.toForLoop
val valueName : string
property Var.Type: System.Type
val value : string
val op : string
val l : string
val r : string
val name : string
property Expr.Type: System.Type
val cn : string
val tn : string
val fn : string
val ignore : value:'T -> unit

Full name: Microsoft.FSharp.Core.Operators.ignore
val s : System.Text.StringBuilder
namespace System.Text
Multiple items
type StringBuilder =
  new : unit -> StringBuilder + 5 overloads
  member Append : value:string -> StringBuilder + 18 overloads
  member AppendFormat : format:string * arg0:obj -> StringBuilder + 4 overloads
  member AppendLine : unit -> StringBuilder + 1 overload
  member Capacity : int with get, set
  member Chars : int -> char with get, set
  member Clear : unit -> StringBuilder
  member CopyTo : sourceIndex:int * destination:char[] * destinationIndex:int * count:int -> unit
  member EnsureCapacity : capacity:int -> int
  member Equals : sb:StringBuilder -> bool
  ...

Full name: System.Text.StringBuilder

--------------------
System.Text.StringBuilder() : unit
System.Text.StringBuilder(capacity: int) : unit
System.Text.StringBuilder(value: string) : unit
System.Text.StringBuilder(value: string, capacity: int) : unit
System.Text.StringBuilder(capacity: int, maxCapacity: int) : unit
System.Text.StringBuilder(value: string, startIndex: int, length: int, capacity: int) : unit
val localAdd : (string -> unit)
val x : string
System.Text.StringBuilder.Append(value: char []) : System.Text.StringBuilder
   (+0 other overloads)
System.Text.StringBuilder.Append(value: obj) : System.Text.StringBuilder
   (+0 other overloads)
System.Text.StringBuilder.Append(value: uint64) : System.Text.StringBuilder
   (+0 other overloads)
System.Text.StringBuilder.Append(value: uint32) : System.Text.StringBuilder
   (+0 other overloads)
System.Text.StringBuilder.Append(value: uint16) : System.Text.StringBuilder
   (+0 other overloads)
System.Text.StringBuilder.Append(value: decimal) : System.Text.StringBuilder
   (+0 other overloads)
System.Text.StringBuilder.Append(value: float) : System.Text.StringBuilder
   (+0 other overloads)
System.Text.StringBuilder.Append(value: float32) : System.Text.StringBuilder
   (+0 other overloads)
System.Text.StringBuilder.Append(value: int64) : System.Text.StringBuilder
   (+0 other overloads)
System.Text.StringBuilder.Append(value: int) : System.Text.StringBuilder
   (+0 other overloads)
val i : string
System.Text.StringBuilder.ToString() : string
System.Text.StringBuilder.ToString(startIndex: int, length: int) : string
val toClass : expr:Expr<'TRet> -> string

Full name: Script.toClass
val expr : Expr<'TRet>
Multiple items
type Expr =
  override Equals : obj:obj -> bool
  member GetFreeVars : unit -> seq<Var>
  member Substitute : substitution:(Var -> Expr option) -> Expr
  member ToString : full:bool -> string
  member CustomAttributes : Expr list
  member Type : Type
  static member AddressOf : target:Expr -> Expr
  static member AddressSet : target:Expr * value:Expr -> Expr
  static member Application : functionExpr:Expr * argument:Expr -> Expr
  static member Applications : functionExpr:Expr * arguments:Expr list list -> Expr
  ...

Full name: Microsoft.FSharp.Quotations.Expr

--------------------
type Expr<'T> =
  inherit Expr
  member Raw : Expr

Full name: Microsoft.FSharp.Quotations.Expr<_>
val returnType : string
System.Text.StringBuilder.AppendLine() : System.Text.StringBuilder
System.Text.StringBuilder.AppendLine(value: string) : System.Text.StringBuilder
val v : string
val mutable fac : int
val i : int

More information

Link:http://fssnip.net/l3
Posted:11 months ago
Author:Phillip Trelford
Tags: java , compiler

This web site is created using F# and Suave web server. It is hosted on Azure and the source code is on GitHub. Contributions are welcome!

The first version of fssnip.net has been created by @tomaspetricek back in 2010. This web site is a new, open-source and contribution-friendly version.