Interpreter of small Assembly machine

Interpreter.fs

module SVM.Interpreter

type ProgramState = 
    {
        ProgramCounter:int
        Memory:  list<(int * SVMAST.Literal)>
        Registers: Map<string, SVMAST.Literal>
        Labels: Map<string, int>
    }

let prettyPrintState (state: ProgramState) =
    printfn "Memory:"
    state.Memory |> List.iter (fun (index, m) -> 
        if index % 10 = 0 && index <> 0 then
            printfn "\n"
        let printValue = 
            match m with
            | SVMAST.Integer (result, _ ) -> result
            | SVMAST.Float (result, _ ) -> result |> int
            | _ -> 0

        printf " %A " printValue
    )

    printfn ""
    printfn "======================="
    
    printfn "Register:"
    state.Registers |> Map.iter (fun key value -> 
        let printValue = 
            match value with
            | SVMAST.Integer (result, _ ) -> result
            | SVMAST.Float (result, _ ) -> result |> int

        printf" %A " printValue
    )
    printfn ""
    printfn "======================="

    printfn "Program Counter:"
    printfn "%d" state.ProgramCounter

let getRegister (arg1: SVMAST.Register, state: ProgramState) = 
    match arg1 with
    | SVMAST.Reg1 -> state.Registers.["Reg1"]
    | SVMAST.Reg2 -> state.Registers.["Reg2"]
    | SVMAST.Reg3 -> state.Registers.["Reg3"]
    | SVMAST.Reg4 -> state.Registers.["Reg4"]

let resolveIntegerValueInRegister (arg1: SVMAST.Register, state: ProgramState) =    
    let reg = getRegister(arg1, state)
    
    let arg1Value =
        match reg with
        | SVMAST.Integer (result, position ) -> (result, position) 
        | _ -> raise (System.ArgumentException("Given -- " + reg.GetType().ToString() + " -- but only allows Integers"))
    
    arg1Value

let resolveFloatValueInRegister (arg1: SVMAST.Register, state) =   
    let reg = getRegister(arg1, state)

    
    let arg1Value =
        match reg with
        | SVMAST.Integer (result, position ) -> (result |> float, position) 
        | SVMAST.Float (result, position) -> (result, position)
        | _ -> raise (System.ArgumentException("Given -- " + reg.GetType().ToString() + " -- but only allows Integers and Floats"))
    
    arg1Value
    

let resolveTypeArg (state: ProgramState, arg2: SVMAST.Literal) =
     match arg2 with 
     | SVMAST.Address (addr) -> 
         match addr with
         | SVMAST.Integer (index, position) -> state.Memory.Item(index) |> snd
         | SVMAST.Register (reg, position) -> 
            let register = getRegister(reg, state)
            match register with
            | SVMAST.Integer(index , position) -> state.Memory.Item(index) |> snd
         | _ -> arg2
     | SVMAST.Register (reg, pos) -> getRegister(reg, state)
     | _ -> arg2

    
let resolveValueInteger (arg2: SVMAST.Literal, state: ProgramState) =
    let value = resolveTypeArg(state, arg2)
    
    let arg2Value =
        match value with
        | SVMAST.Integer (result, _ ) -> result
        | _ -> raise (System.ArgumentException("Given -- " + value.GetType().ToString() + " -- But only allows Integers"))

    arg2Value

let resolveValueIntegerFloat (arg2: SVMAST.Literal, state: ProgramState) =
    let value = resolveTypeArg(state, arg2)
    
    let arg2Value =
        match value with
        | SVMAST.Integer (result, _ ) -> result |> float
        | SVMAST.Float (result, _ ) -> result
        | _ -> raise (System.ArgumentException("Given -- " + value.GetType().ToString() + " -- but only allows Integers and Floats"))

    arg2Value
    

let insertIntoMemory(index: int, state: ProgramState, valToInsert: SVMAST.Literal) =
    let newMemoryList = 
        state.Memory |> List.map (fun addr -> 
            if fst(addr).Equals(index) then (fst(addr), valToInsert) else addr
        )
    { state with ProgramCounter = state.ProgramCounter+1; Memory = newMemoryList }

let insertIntoRegister(register: SVMAST.Register, state: ProgramState, valToInsert: SVMAST.Literal) =
    let register =
        match register with
        | SVMAST.Reg1 -> "Reg1"
        | SVMAST.Reg2 -> "Reg2"
        | SVMAST.Reg3 -> "Reg3"
        | SVMAST.Reg4 -> "Reg4"
    
    let newRegisters = state.Registers.Add(register, valToInsert)

    { state with ProgramCounter = state.ProgramCounter+1; Registers = newRegisters}


let NOP (state: ProgramState) = 
    { state with ProgramCounter = state.ProgramCounter+1}


let MOV (arg1: SVMAST.Literal, arg2: SVMAST.Literal, state: ProgramState) =
    let value = resolveTypeArg(state, arg2)

    match arg1 with
    | SVMAST.Address(x) -> 
        match x with 
        | SVMAST.Integer (index,position) -> 
            insertIntoMemory(index, state, value)
        | SVMAST.Register (reg, _) -> 
            match getRegister(reg, state) with
            | SVMAST.Integer (index, _ ) -> insertIntoMemory(index, state, value)
               
    | SVMAST.Register(reg,pos) -> insertIntoRegister(reg, state, value)
    | _ -> raise (System.ArgumentException("Invalid argument type for the MOV command -> " + arg1.GetType().ToString()))


let AND (arg1: SVMAST.Register, arg2: SVMAST.Literal, state: ProgramState) =
    let arg1Value = resolveIntegerValueInRegister(arg1, state)
    let arg2Value = resolveValueInteger(arg2, state)

    if fst(arg1Value) > 0 && arg2Value > 0 then
        insertIntoRegister(arg1, state, SVMAST.Integer(1, snd(arg1Value)))
    else 
        insertIntoRegister(arg1, state, SVMAST.Integer(-1, snd(arg1Value)))

let OR (arg1: SVMAST.Register, arg2: SVMAST.Literal, state: ProgramState) =
    let arg1Value = resolveIntegerValueInRegister(arg1, state)
    let arg2Value = resolveValueInteger(arg2, state)

    if (fst(arg1Value) > 0 || arg2Value > 0) then
        insertIntoRegister(arg1, state, SVMAST.Integer(1, snd(arg1Value)))
    else 
        insertIntoRegister(arg1, state, SVMAST.Integer(-1, snd(arg1Value)))

let NOT (arg1: SVMAST.Register, state) =
    let arg1Value = resolveIntegerValueInRegister(arg1, state)
    
    if fst(arg1Value) < 0 then
        insertIntoRegister(arg1, state, SVMAST.Integer(0, snd(arg1Value)))
    else
        insertIntoRegister(arg1, state, SVMAST.Integer(-1, snd(arg1Value)))

let MOD (arg1: SVMAST.Register, arg2: SVMAST.Literal , state: ProgramState) =
    let arg1Value = resolveFloatValueInRegister(arg1, state)
    let arg2Value = resolveValueIntegerFloat (arg2, state)

    let modulus = fst(arg1Value) % arg2Value

    if modulus % 1.0 <> 0.0 then
        insertIntoRegister (arg1, state, SVMAST.Float(modulus, snd(arg1Value)))
    else
        insertIntoRegister (arg1, state, SVMAST.Integer(modulus |> int, snd(arg1Value)))

let ADD (arg1: SVMAST.Register, arg2: SVMAST.Literal, state: ProgramState) = 
    let arg1Value = resolveFloatValueInRegister(arg1, state)
    let arg2Value = resolveValueIntegerFloat(arg2, state)

    let sum = fst(arg1Value) + arg2Value

    if sum % 1.0 <> 0.0 then
        insertIntoRegister (arg1, state, SVMAST.Float(sum, snd(arg1Value)))
    else
        insertIntoRegister (arg1, state, SVMAST.Integer(sum |> int, snd(arg1Value)))

let SUB (arg1: SVMAST.Register, arg2: SVMAST.Literal, state: ProgramState) =
    let arg1Value = resolveFloatValueInRegister(arg1, state)
    let arg2Value = resolveValueIntegerFloat(arg2, state)

    let sub = fst(arg1Value) - arg2Value

    if sub % 1.0 <> 0.0 then
        insertIntoRegister (arg1, state, SVMAST.Float(sub, snd(arg1Value)))
    else
        insertIntoRegister (arg1, state, SVMAST.Integer(sub |> int, snd(arg1Value)))

let MUL (arg1: SVMAST.Register, arg2: SVMAST.Literal, state: ProgramState) =
    let arg1Value = resolveFloatValueInRegister(arg1, state)
    let arg2Value = resolveValueIntegerFloat(arg2, state)

    let sub = fst(arg1Value) * arg2Value

    if sub % 1.0 <> 0.0 then
        insertIntoRegister (arg1, state, SVMAST.Float(sub, snd(arg1Value)))
    else
        insertIntoRegister (arg1, state, SVMAST.Integer(sub |> int, snd(arg1Value)))

let DIV (arg1: SVMAST.Register, arg2: SVMAST.Literal, state: ProgramState) =
    let arg1Value = resolveFloatValueInRegister(arg1, state)
    let arg2Value = resolveValueIntegerFloat(arg2, state)

    let sub = fst(arg1Value) / arg2Value

    if sub % 1.0 <> 0.0 then
        insertIntoRegister (arg1, state, SVMAST.Float(sub, snd(arg1Value)))
    else
        insertIntoRegister (arg1, state, SVMAST.Integer(sub |> int, snd(arg1Value)))

let CMP (arg1: SVMAST.Register, arg2: SVMAST.Literal, state: ProgramState) =
    let arg1Value = resolveFloatValueInRegister(arg1, state)
    let arg2Value = resolveValueIntegerFloat(arg2, state)

    let result =
        if fst(arg1Value) < arg2Value then
            -1
        else if fst(arg1Value) = arg2Value then
            0
        else
            1

    insertIntoRegister (arg1, state, SVMAST.Integer(result , snd(arg1Value)))

let JMP (arg1:string, state: ProgramState) =
    let position = state.Labels.[arg1]
    { state with ProgramCounter = position }

let JC (arg1:string, arg2:SVMAST.Register, state: ProgramState) =
    let compareResult = resolveIntegerValueInRegister(arg2, state)

    if compareResult |> fst > -1 then
        JMP(arg1, state)
    else 
        { state with ProgramCounter = state.ProgramCounter+1 }

let JEQ (arg1:string, arg2:SVMAST.Register, state: ProgramState) =
    let compareResult = resolveIntegerValueInRegister(arg2, state)

    if compareResult |> fst = 0 then
        JMP(arg1, state)
    else 
        { state with ProgramCounter = state.ProgramCounter+1 }
    
let executeInstruct(instruction: SVMAST.Instruction, state: ProgramState) =
    match instruction with
    | SVMAST.Nop (x,y) -> NOP(state)
    | SVMAST.Mov (arg1,arg2,_) -> MOV(arg1,arg2,state)
    | SVMAST.And (arg1, arg2, _ ) -> AND(arg1, arg2, state)
    | SVMAST.Or (arg1, arg2, _ ) -> OR(arg1, arg2, state)
    | SVMAST.Not (arg1, _) -> NOT(arg1, state)
    | SVMAST.Cmp (arg1, arg2, _) -> CMP(arg1, arg2, state)
    | SVMAST.Mod (arg1, arg2, _ ) -> MOD(arg1, arg2, state)
    | SVMAST.Add (arg1, arg2, _ ) -> ADD(arg1, arg2, state)
    | SVMAST.Sub (arg1, arg2, _ ) -> SUB(arg1, arg2, state)
    | SVMAST.Mul (arg1, arg2, _ ) -> MUL(arg1, arg2, state)
    | SVMAST.Div (arg1, arg2, _ ) -> DIV(arg1, arg2, state)
    | SVMAST.Jmp (arg1, _ ) -> JMP(arg1, state)
    | SVMAST.Jc (arg1, arg2, _ ) -> JC(arg1, arg2, state)
    | SVMAST.Jeq (arg1, arg2, _ ) -> JEQ(arg1, arg2, state)
    | _ ->  { state with ProgramCounter = state.ProgramCounter+1}


let resolvePositionForLabel (label:string, instructions: SVMAST.Instruction list) =
    List.findIndex (fun x -> 
        match x with 
        | SVMAST.Label (labelName, _) -> labelName = label
        | _ -> false
    ) instructions

let resolveAST(instruction: SVMAST.Instruction list, memory:int) =
    let memoryList = List.init memory (fun x -> (x,SVMAST.LiteralIdentifier))

    let registerMap = 
      Map.empty.
        Add("Reg1", SVMAST.Integer(0,(0,0))).
        Add("Reg2", SVMAST.Integer(0,(0,0))).
        Add("Reg3", SVMAST.Integer(0,(0,0))).
        Add("Reg4", SVMAST.Integer(0,(0,0)))

    
    let labels = 
        List.fold (fun (acc:Map<string, int>) item -> 
            match item with
            | SVMAST.Label (label,_) -> 
                if (acc.ContainsKey label) then 
                    raise(System.ArgumentException("Label defined twice => " + label))
                else 
                    acc.Add(label,resolvePositionForLabel(label, instruction))
            | _ -> acc
        ) Map.empty instruction


    let initialState = { ProgramCounter = 0; Memory = memoryList; Registers = registerMap; Labels = labels}

    let rec parseInstruction (instruction: SVMAST.Instruction list, state: ProgramState) =
        if state.ProgramCounter < instruction.Length then
            parseInstruction(instruction, executeInstruct(instruction.Item(state.ProgramCounter), state))
        else 
            state

    parseInstruction(instruction, initialState)