SWiP - Lab 3

open System

type instruction =
    | ADD
    | SUB
    | MUL
    | DIV
    | SQR
    | TAN
    | WRX
    | RDX
    | PUSH of float

type stack = float list

exception BLEDNY_PROGRAM of (instruction * stack);
exception DOMAIN;

let intInstr (x , y) =
    match  x, y  with
    | ADD, a::b::ys -> (b + a) :: ys : stack
    | ADD, a::ys -> ( printf "ADD, jeden argument\n"; raise (BLEDNY_PROGRAM(x, y)))
    | ADD, [] -> ( printf "ADD, brak argumentów\n"; raise (BLEDNY_PROGRAM(x, y)))
    | SUB, a::b::ys -> (b - a) :: ys
    | MUL, a::b::ys -> try (b * a) :: ys with
                                        | :? OverflowException -> (
                                                                    printf "Przelano wartość"
                                                                    Double.MaxValue :: ys
                                        )
    | DIV, a::b::ys -> try (b / a) :: ys with
                                        | :? DivideByZeroException -> (
                                                                        printf "Nie dziel przez 0"
                                                                        0.0 :: ys
                                        )
    | SQR, a::ys -> (a * a) :: ys
    | TAN, a::ys -> try if Math.Cos(a) = 0.0 then raise DOMAIN else Math.Tan(a) :: ys with
                                        | :? DOMAIN -> (
                                                        printf "TAN: Invalid domain"
                                                        Double.MaxValue :: ys
                                        )
    | PUSH x, ys -> x::ys
    | _, _ -> raise (BLEDNY_PROGRAM(x, y));

let wypisz_instr = function
    | ( PUSH x) -> "PUSH " + Convert.ToString(x)
    | ( SQR ) -> " SQR "
    | ( ADD ) -> " ADD "
    | ( SUB ) -> " SUB "
    | ( MUL ) -> " MUL ";

let rec wypisz = function
    | [] -> ""
    | x::xs -> ((wypisz_instr x) + ";" + (wypisz xs))

let intpProg(is) =
    let rec iPS = function
        | ([], x::xs) -> x
        | (i::is, xs) -> (
                            printf "Przycisk %A\n" i
                            let _ = Console.ReadKey true
                            try iPS(is, intInstr(i, xs)) with
                                                    BLEDNY_PROGRAM(a, b) -> (
                                                                            printf "%s" (wypisz(is))
                                                                            -1.0
                                                    )
        )
    iPS(is, [])

type boolInstruction =
    | OR
    | NOT
    | UP of bool

let boolOperation = function
    | OR, a::b::rest -> (a || b) :: rest
    | NOT, a::rest -> (not a) :: rest
    | UP a, rest -> a :: rest

let boolProc(is) =
    let rec boolPS = function
        | ([], x::xs) -> x
        | (i::is, xs) -> boolPS(is, boolOperation(i, xs))
    boolPS(is, [])

let intInstrWithR (x, y, r) =
    match  x, y, r  with
    | ADD, a::b::ys, r -> ((b + a) :: ys, r)
    | ADD, a::ys, r -> ( printf "ADD, jeden argument\n"; raise (BLEDNY_PROGRAM(x, y)))
    | ADD, [], r -> ( printf "ADD, brak argumentów\n"; raise (BLEDNY_PROGRAM(x, y)))
    | SUB, a::b::ys, r -> ((b - a) :: ys, r)
    | MUL, a::b::ys, r -> try ((b * a) :: ys, r) with
                                        | :? OverflowException -> (
                                                                    printf "Przelano wartość"
                                                                    (Double.MaxValue :: ys, r)
                                        )
    | DIV, a::b::ys, r -> try ((b / a) :: ys, r) with
                                        | :? DivideByZeroException -> (
                                                                        printf "Nie dziel przez 0"
                                                                        (0.0 :: ys, r)
                                        )
    | SQR, a::ys, r -> ((a * a) :: ys, r)
    | TAN, a::ys,r  -> try if Math.Cos(a) = 0.0 then raise DOMAIN else (Math.Tan(a) :: ys, r) with
                                        | :? DOMAIN -> (
                                                        printf "TAN: Invalid domain"
                                                        (Double.MaxValue :: ys, r)
                                        )
    | PUSH x, ys, r -> (x::ys, r)
    | WRX, y::ys, r -> (y::ys, y)
    | RDX, ys, r -> (r::ys, r)
    | _, _, _ -> raise (BLEDNY_PROGRAM(x, y));

let intpProgWithR(is) =
    let rec iPS = function
        | ([], (x::xs, r)) -> x
        | (i::is, (xs, r)) -> (
                                printf "Przycisk %A\n" i
                                let _ = Console.ReadKey true
                                try iPS(is, intInstrWithR(i, xs, r)) with
                                                    BLEDNY_PROGRAM(a, b) -> (
                                                                            printf "%s" (wypisz(is))
                                                                            -1.0
                                                    )
        )
    iPS(is, ([], 0.0))

[<EntryPoint>]
let main argv =
    let stos: stack = [];
    let stos1 = intInstr(PUSH 3.0, stos);
    let stos2 = try intInstr(ADD, stos1) with
                                            BLEDNY_PROGRAM(a, b) -> (
                                                                    //printf "Wyjątek: Błędne wykonanie programu.\nOperand: %A, Stos: %A\n" a b;
                                                                    b
                                            )
    let il1 = [PUSH 3.0; PUSH 4.0; ADD; PUSH 2.0; MUL]
    let il2 = [PUSH 3.0; PUSH 4.0; ADD; PUSH 2.0];
    let il3 = [PUSH 3.0; PUSH 4.0; ADD; MUL; ADD; SUB];
    let divide0Error = [PUSH 0.0; PUSH 1.0; DIV; PUSH 1.0; ADD]
    let oveflow = [PUSH Double.MaxValue; PUSH 2.0; MUL; PUSH 1.0; SUB]
    let tan = [PUSH 2.0; TAN]
    let add1 = [PUSH 2.0; ADD]
    let add0 = [ADD]
    let wa = intpProg(add1)
    let w1 = intpProg(add0)
    //let w = boolProc([UP true; NOT; UP false; OR])
    let withR = [PUSH 2.0; PUSH 3.0; ADD; WRX; PUSH 3.0; MUL; PUSH 4.0; RDX; MUL; ADD;]
    let w = intpProgWithR(withR)
    printfn "%A" w
    //printfn "%A" stos2
    0 // return an integer exit code