gistfile1.fs

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

type Variable = Variable of string

type Expression = 
    | VarExp of Variable
    | Const of float
    | Neg of Expression
    | Add of Expression * Expression
    | Sub of Expression * Expression
    | Mul of Expression * Expression
    | Div of Expression * Expression
    | Pow of Expression * Expression
    | Exp of Expression
    | Log of Expression
    | Sin of Expression
    | Cos of Expression

type Equation = 
    | Equation of Expression * Expression

let parseQuotation quot : Equation =
    let rec parseExpr expr =
        match expr with
        | SpecificCall <@@ (+) @@> (_, _, exprList) ->
            let left = parseExpr exprList.Head
            let right = parseExpr exprList.Tail.Head
            Add(left, right)
        | SpecificCall <@@ (-) @@> (_, _, exprList) ->
            let left = parseExpr exprList.Head
            let right = parseExpr exprList.Tail.Head
            Sub(left, right)
        | SpecificCall <@@ (*) @@> (_, _, exprList) ->
            let left = parseExpr exprList.Head
            let right = parseExpr exprList.Tail.Head
            Mul(left, right)
        | SpecificCall <@@ (/) @@> (_, _, exprList) ->
            let left = parseExpr exprList.Head
            let right = parseExpr exprList.Tail.Head
            Div(left, right)
        | SpecificCall <@@ Math.Pow @@> (_, _, exprList) ->
            let left = parseExpr exprList.Head
            let right = parseExpr exprList.Tail.Head
            Pow(left, right)
        | SpecificCall <@@ Math.Exp @@> (_, _, exprList) ->
            let arg = parseExpr exprList.Head
            Exp(arg)
        | SpecificCall <@@ Math.Log @@> (_, _, exprList) ->
            let arg = parseExpr exprList.Head
            Log(arg)
        | SpecificCall <@@ Math.Sin @@> (_, _, exprList) ->
            let arg = parseExpr exprList.Head
            Sin(arg)
        | SpecificCall <@@ Math.Cos @@> (_, _, exprList) ->
            let arg = parseExpr exprList.Head
            Cos(arg)
        | Var(var) ->
            VarExp(Variable(var.Name))
        | Int32(n) ->
            Const (float n)
        | Double(f) ->
            Const f
        | _ -> failwith (sprintf "not implemented:parseQuotation:%A" expr)
    match quot with
    | SpecificCall <@@ (=) @@> (_, _, exprList) ->
        let left = parseExpr exprList.Head
        let right = parseExpr exprList.Tail.Head
        Equation(left, right)
    | _ -> failwith "invalid"


type Point = Point of x : Variable * y : Variable

type Constraint =
| PointEqual of Point * Point

let ToEquations (eq : Constraint) : Expr list =
    match eq with
    | PointEqual(Point(ax, ay),Point(bx, by)) ->
        [ 
          <@ ax = bx  @>
          <@ ay = by  @>
        ]

[<EntryPoint>]
let main argv =
    printfn "%A" ((ToEquations (PointEqual(Point(Variable "ax1",Variable "ay1"),Point(Variable "bx1",Variable "by1")))) |> List.map parseQuotation)
    0 // return an integer exit code