nullreferenceinfsharp.fs

module SVMInterpreter
open SVMAST
open System

type State = {
    memory : Literal list;
    registers : Literal list; 
    program : Program;
    pc : int;
    labels : Map<string, (int)> ;
} with
    static member Create program memsize =
        {
            memory = List.init memsize (fun x -> Integer(0,(0,0)));
            registers = List.init 4 (fun x -> Integer(0,(0,0)));
            program = program;
            pc = 0;
            labels = Map.empty
        }

let readRegister register (state : State) = 
    match register with 
        | Reg1 -> state.registers.[0]
        | Reg2 -> state.registers.[1]
        | Reg3 -> state.registers.[2]
        | Reg4 -> state.registers.[3]

let followAddress address (state : State) = 
    match address with
        | Register (r, p) ->  
            match readRegister r state with
                | Integer (i, p) -> i
                | _ -> failwith "Invalid argument"
        | Integer (i, p) -> i 

let evaluate arg state = 
    match arg with 
        | Address (l) -> state.memory.[followAddress l state]
        | Register (r, p) -> readRegister r state
        | Integer (i, p) -> arg
        | Float (f, p) -> arg
        | String (s, p) -> arg

let writeRegister register value (state : State) =
    match register with
        | Reg1 -> {state with registers = List.mapi (fun i v -> if i = 0 then value else v) state.registers}
        | Reg2 -> {state with registers = List.mapi (fun i v -> if i = 1 then value else v) state.registers}
        | Reg3 -> {state with registers = List.mapi (fun i v -> if i = 2 then value else v) state.registers}
        | Reg4 -> {state with registers = List.mapi (fun i v -> if i = 3 then value else v) state.registers}

let NOP state = state

let MOV arg1 arg2 state = 
    let value = evaluate arg2 state
    match arg1 with
    | Address (l) -> let address = followAddress l state in {state with memory = List.mapi (fun i v -> if i = address then value else v) state.memory}
    | Register (r, p) -> writeRegister r value state
    | _ -> failwith "First argument must be Address or Register" 

let AND arg1 arg2 state = 
    let firstvalue = readRegister arg1 state
    let secondvalue = evaluate arg2 state
    match firstvalue, secondvalue with
    | Integer (i, p), Integer (ii, pp) -> if i >= 0 && ii >= 0 then writeRegister arg1 (Integer(1, p)) state else writeRegister arg1 (Integer(-1, p)) state
    | _ -> failwith "Argument must be integer value"

let OR arg1 arg2 state = 
    let firstvalue = readRegister arg1 state
    let secondvalue = evaluate arg2 state
    match firstvalue, secondvalue with
    | Integer (i, p), Integer (ii, pp) -> if i < 0 && ii < 0 then writeRegister arg1 (Integer(-1, p)) state else writeRegister arg1 (Integer(1, p)) state
    | _ -> failwith "Argument must be integer value"

let NOT arg1 state =
    let value = readRegister arg1 state 
    match value with
    | Integer (i, p) -> if i < 0 then writeRegister arg1 (Integer(0, p)) state else writeRegister arg1 (Integer(-1, p)) state
    | _ -> failwith "Argument must be integer value"

let gay intoperation floatoperation arg1 arg2 state = 
    let firstvalue = readRegister arg1 state
    let secondvalue = evaluate arg2 state
    match firstvalue, secondvalue with
    | Integer (i, p), Integer (ii, pp) -> writeRegister arg1 (Integer(intoperation i ii, p)) state 
    | Float (f, p), Float (ff, pp) -> writeRegister arg1 (Float(floatoperation f ff, p)) state 
    | _ -> failwith "Argument must be integer or float value"

let MODGAY = gay (fun x y -> x % y) (fun x y -> x % y)
let ADDGAY = gay (fun x y -> x + y) (fun x y -> x + y)
let SUBGAY = gay (fun x y -> x - y) (fun x y -> x - y)
let MULGAY = gay (fun x y -> x * y) (fun x y -> x * y)
let DIVGAY = gay (fun x y -> x / y) (fun x y -> x / y)

let CMP arg1 arg2 state = 
    let firstvalue = readRegister arg1 state
    let secondvalue = evaluate arg2 state
    match firstvalue, secondvalue with
    | Integer (i, p), Integer (ii, pp) -> if i < ii then writeRegister arg1 (Integer(1, p)) state else if i = ii then writeRegister arg1 (Integer(0, p)) state else writeRegister arg1 (Integer(1, p)) state
    | Float (f, p), Float (ff, pp) -> if f < ff then writeRegister arg1 (Float(1.0, p)) state else if f = ff then writeRegister arg1 (Float(0.0, p)) state else writeRegister arg1 (Float(1.0, p)) state
    | _ -> failwith "Argument must be integer or float value"

let LABEL arg1 state = 
    let s = arg1
    if Map.containsKey s state.labels then failwith "Label already exists" else {state with labels = (Map.add s (state.pc) state.labels)}
  

let JUMP arg1 state = {state with pc = state.labels.[arg1]} 
    
let JC arg1 arg2 state =
    let secondvalue = readRegister arg2 state
    match secondvalue with
    | Integer(i , pp) -> if i >= 0 then {state with pc = state.labels.[arg1]} else state
    | _ -> failwith "Value not an ID or Integer"

let JEQ arg1 arg2 state =
    let secondvalue = readRegister arg2 state
    match secondvalue with
    | Integer(i , pp) -> if i = 0 then {state with pc = state.labels.[arg1]} else state
    | _ -> failwith "Value not an ID or Integer"

let INCPC state = {state with pc = state.pc+1}

let printState (state : State) = 
//    do List.iter (fun x -> printf "%A" x) state.memory
//    do List.iter (fun x -> printf "%A" x) state.registers
    do printf "%A" state.pc

let _evaluate instruction state = 
    do printState state
    match instruction with 
    | Nop _ -> NOP state
    | Mov(arg1, arg2, _) -> MOV arg1 arg2 state 
    | And(arg1, arg2, _) -> AND arg1 arg2 state
    | Or(arg1, arg2, _) -> OR arg1 arg2 state
    | Not (arg1, _) -> NOT arg1 state
    | Mod(arg1, arg2, _) -> MODGAY arg1 arg2 state
    | Add(arg1, arg2, _) -> ADDGAY arg1 arg2 state
    | Sub (arg1, arg2, _) -> SUBGAY arg1 arg2 state
    | Mul(arg1, arg2, _) -> MULGAY arg1 arg2 state
    | Div (arg1, arg2, _) -> DIVGAY arg1 arg2 state
    | Cmp(arg1, arg2, _) -> CMP arg1 arg2 state
    | Jmp (arg1, _) -> JUMP arg1 state
    | Jc (arg1, arg2, _) -> JC arg1 arg2 state
    | Jeq (arg1, arg2, _) -> JEQ arg1 arg2 state
    | Label (arg1, _) -> LABEL arg1 state

let Run program = 
    let state = State.Create program 111
    let rec eval (state : State) = 
        if state.pc < state.program.Length then
            eval { (_evaluate state.program.[state.pc] state) with pc = state.pc+1}
            printState state
        else 
            ()
    eval state