module Assignment3

type 'a BinTree =
      Leaf
    | Node of 'a * 'a BinTree * 'a BinTree

// 3.1
let rec inOrder bTree =
    match bTree with
    | Leaf -> []
    | Node(v,left,right) -> (inOrder left) @ [v] @ (inOrder right)

// 3.2
let rec mapInOrder f bTree =
    match bTree with
    | Leaf -> Leaf
    | Node(v,left,right) -> Node(f v, (mapInOrder f left), (mapInOrder f right))

// 3.3
let rec foldInOrder f e bTree =
    match bTree with
    | Leaf -> e
    | Node(v,left,right) -> f v (foldInOrder f left right)

// 3.4, 3.5, 3.6
let update x v s = Map.add x v s

type aExp =
    | N of int
    | V of string
    | Add of aExp * aExp
    | Mul of aExp * aExp
    | Sub of aExp * aExp
    | Inc of string

let rec A a s =
    match a with
    | N n         -> (n,s)
    | V x         -> (Map.find x s, s)
    | Add(a1, a2) -> let (x,_) = A a1 s
                     let (y,_) = A a2 s
                     (x+y,s)
    | Mul(a1, a2) -> let (x,_) = A a1 s
                     let (y,_) = A a2 s
                     (x*y,s)
    | Sub(a1, a2) -> let (x,_) = A a1 s
                     let (y,_) = A a2 s
                     (x-y,s)
    | Inc x       -> let n = Map.find x s in (n+1, update x (n+1) s)

type bExp =
    | TT
    | FF
    | Eq of aExp * aExp
    | Lt of aExp * aExp
    | Neg of bExp
    | Con of bExp * bExp

let rec B b s =
    match b with
    | TT -> true
    | FF -> false
    | Eq (a1, a2) -> a1 = a2
    | Lt (a1, a2) -> a1 < a2
    | Neg b -> not (B b s)
    | Con (b1, b2) -> (B b1 s) && (B b2 s)


type stm =
    | Ass of string * aExp
    | Skip
    | Seq of stm * stm
    | ITE of bExp * stm * stm
    | While of bExp * stm
    | IF of bExp * stm
    | RU of bExp * stm
    | Inc of string

let rec I stm s =
    match stm with
    | Ass(x,a) -> update x a s
    | Skip -> s
    | Seq(stm1,stm2) -> I stm2 (I stm1 s)
    | ITE(b,stm1,stm2) -> if B b s then I stm1 s else I stm2 s
    | While(b,stm) -> if B b s then I stm s else s
    | IF(b,stm) -> I (ITE(b,stm,Skip)) s
    | RU(b,stm) -> I (Seq(stm,While(Neg b, stm))) s
    | Inc(x) -> I (Ass(x, Add(V x, N 1))) s

// 3.4 - examples

let ex1 = Add(Sub(N 45, N 11), N 22)

let ex2 = Add(Mul(N 10, N 32),Sub(N 15, N 10))

let ex3 = Mul(N 33, Add(N 33, N 2))

let ex4 = Add(ex1, ex2)

let ex5 = Add(ex4,Sub(N 100, N 33))

// 3.7

type Fexpr =
    | Const of float
    | X
    | Add of Fexpr * Fexpr
    | Sub of Fexpr * Fexpr
    | Mul of Fexpr * Fexpr
    | Div of Fexpr * Fexpr
    | Sin of Fexpr
    | Cos of Fexpr
    | Log of Fexpr
    | Exp of Fexpr

let rec postfix fe =
    match fe with
    | Const c -> c.ToString(System.Globalization.CultureInfo.InvariantCulture)
    | X -> X.ToString()
    | Add(x,y) -> (postfix x) + " " + (postfix y) + " +"
    | Sub(x,y) -> (postfix x) + " " + (postfix y) + " -"
    | Mul(x,y) -> (postfix x) + " " + (postfix y) + " *"
    | Div(x,y) -> (postfix x) + " " + (postfix y) + " /"
    | Sin(x) -> (postfix x) + "sin "
    | Cos(x) -> (postfix x) + "cos "
    | Log(x) -> (postfix x) + "log "
    | Exp(x) -> (postfix x) + "exp "


// 3.8
type Instruction =
    | ADD | SUB | MULT | DIV | SIN
    | COS | LOG | EXP  | PUSH of float

// 3.8 part 1
type Stack =
    | Empty
    | Stack of float * Stack


let intpInstr st inst =
    match st with
    | Empty ->
        match inst with
        | PUSH f -> Stack(f, Empty)
        | _ -> st
    | Stack(x,Empty) ->
        match inst with
        | PUSH f -> Stack(f, st)
        | SIN    -> Stack(System.Math.Sin(x), Empty)
        | COS    -> Stack(System.Math.Cos(x), Empty)
        | LOG    -> Stack(System.Math.Log(x), Empty)
        | EXP    -> Stack(System.Math.Exp(x), Empty)
        | _ -> st
    | Stack(x,Stack(y,s)) ->
        match inst with
        | PUSH f -> Stack(f,st)
        | SIN    -> Stack(System.Math.Sin(x),Stack(y,s))
        | COS    -> Stack(System.Math.Cos(x),Stack(y,s))
        | LOG    -> Stack(System.Math.Log(x),Stack(y,s))
        | EXP    -> Stack(System.Math.Exp(x),Stack(y,s))
        | ADD    -> Stack((y + x), s)
        | SUB    -> Stack((y - x), s)
        | MULT   -> Stack((y * x), s)
        | DIV    -> Stack((y / x), s)

// 3.8 part 2

let intpProg instSet = function
        (Stack(f,_)) ->
            List.foldBack (fun inst stack -> intpInstr stack inst) instSet Empty


// 3.8 part 3
let rec trans (fe, x) =
    match fe with
    | Const c -> [PUSH c]
    | X -> trans(X, x)
    | Add(a,b) -> ADD  :: (trans (b, x)) @ (trans (a, x))
    | Sub(a,b) -> SUB  :: (trans (b, x)) @ (trans (a, x))
    | Mul(a,b) -> MULT :: (trans (b, x)) @ (trans (a, x))
    | Div(a,b) -> DIV  :: (trans (b, x)) @ (trans (a, x))
    | Sin(a)   -> SIN  :: (trans (a, x))
    | Cos(a)   -> COS  :: (trans (a, x))
    | Log(a)   -> LOG  :: (trans (a, x))
    | Exp(a)   -> EXP  :: (trans (a, x))

// 3.9
(*
 See the file ComplexNumbers.fs
*)