Semantics for RISC code
This commit is contained in:
elvis
177
lib/miniImp/RISCSemantics.ml
Normal file
177
lib/miniImp/RISCSemantics.ml
Normal file
@ -0,0 +1,177 @@
|
||||
module Register = struct
|
||||
type t = {index: string}
|
||||
|
||||
let compare a b = compare a.index b.index
|
||||
end
|
||||
|
||||
|
||||
module CodeMap = Map.Make(String)
|
||||
module RegisterMap = Map.Make(Register)
|
||||
module MemoryMap = Map.Make(Int)
|
||||
|
||||
module RISCArchitecture = struct
|
||||
type t = {
|
||||
code: RISC.RISCAssembly.risci list CodeMap.t;
|
||||
registers: int RegisterMap.t;
|
||||
memory: int MemoryMap.t
|
||||
}
|
||||
end
|
||||
|
||||
let convert (prg: RISC.RISCAssembly.t) : RISC.RISCAssembly.risci list CodeMap.t =
|
||||
let rec helper
|
||||
(prg: RISC.RISCAssembly.risci list)
|
||||
(current: RISC.RISCAssembly.risci list)
|
||||
(current_label: string)
|
||||
(map: RISC.RISCAssembly.risci list CodeMap.t)
|
||||
: (RISC.RISCAssembly.risci list CodeMap.t) =
|
||||
match prg with
|
||||
| [] -> (CodeMap.union
|
||||
(fun _ _ _ -> failwith "Two labels are the same")
|
||||
(CodeMap.singleton current_label current)
|
||||
map)
|
||||
| Label l :: tl -> helper tl ([]) l
|
||||
(CodeMap.union
|
||||
(fun _ _ _ -> failwith "Two labels are the same")
|
||||
(CodeMap.singleton current_label current)
|
||||
map)
|
||||
| instr :: tl -> helper tl (current @ [instr]) current_label map
|
||||
in
|
||||
match prg.code with
|
||||
| Label "main" :: tl -> helper tl [] "main" CodeMap.empty
|
||||
| _ -> failwith "Program should begind with label main"
|
||||
|
||||
let label_order (prg: RISC.RISCAssembly.t) : string list =
|
||||
let rec helper
|
||||
(prg: RISC.RISCAssembly.risci list)
|
||||
: string list =
|
||||
match prg with
|
||||
[] -> []
|
||||
| Label l :: tl -> l :: (helper tl)
|
||||
| _ :: tl -> (helper tl)
|
||||
in
|
||||
helper (prg.code)
|
||||
|
||||
let reduce_instructions (prg: RISCArchitecture.t) (lo: string list) : int =
|
||||
let match_operator_r (brop: RISC.RISCAssembly.brop) =
|
||||
match brop with
|
||||
| Add -> (+)
|
||||
| Sub -> (-)
|
||||
| Mult -> ( * )
|
||||
| Div -> (/)
|
||||
| Mod -> (mod)
|
||||
| Pow -> (Utility.pow)
|
||||
| And -> (Utility.int_and)
|
||||
| Or -> (Utility.int_or)
|
||||
| Eq -> (Utility.int_eq)
|
||||
| Less -> (Utility.int_less)
|
||||
| LessEq -> (Utility.int_less_eq)
|
||||
| More -> (Utility.int_more)
|
||||
| MoreEq -> (Utility.int_more_eq)
|
||||
in
|
||||
let match_operator_i (biop: RISC.RISCAssembly.biop) =
|
||||
match biop with
|
||||
| AddI -> (+)
|
||||
| SubI -> (-)
|
||||
| MultI -> ( * )
|
||||
| DivI -> (/)
|
||||
| ModI -> (mod)
|
||||
| PowI -> (Utility.pow)
|
||||
| AndI -> (Utility.int_and)
|
||||
| OrI -> (Utility.int_or)
|
||||
| EqI -> (Utility.int_eq)
|
||||
| LessI -> (Utility.int_less)
|
||||
| LessEqI -> (Utility.int_less_eq)
|
||||
| MoreI -> (Utility.int_more)
|
||||
| MoreEqI -> (Utility.int_more_eq)
|
||||
in
|
||||
|
||||
let rec helper
|
||||
(prg: RISCArchitecture.t)
|
||||
(current: RISC.RISCAssembly.risci list)
|
||||
(current_label: string)
|
||||
: RISCArchitecture.t =
|
||||
match current with
|
||||
| [] -> (
|
||||
(* falls to the next label *)
|
||||
match List.find_index ((=) current_label) lo with
|
||||
None -> prg (* should never happen *)
|
||||
| Some i ->
|
||||
if i + 1 < (List.length lo) then
|
||||
helper prg (CodeMap.find (List.nth lo (i+1)) prg.code) (List.nth lo (i+1))
|
||||
else
|
||||
prg
|
||||
)
|
||||
| Nop :: tl -> helper prg tl current_label
|
||||
| BRegOp (brop, r1, r2, r3) :: tl -> (
|
||||
let n = (match_operator_r brop)
|
||||
(RegisterMap.find {index = r1.index} prg.registers)
|
||||
(RegisterMap.find {index = r2.index} prg.registers)
|
||||
in
|
||||
helper {prg with registers = RegisterMap.add {index = r3.index} n prg.registers} tl current_label
|
||||
)
|
||||
| BImmOp (biop, r1, i, r3) :: tl -> (
|
||||
let n = (match_operator_i biop)
|
||||
(RegisterMap.find {index = r1.index} prg.registers)
|
||||
i
|
||||
in
|
||||
helper {prg with registers = RegisterMap.add {index = r3.index} n prg.registers} tl current_label
|
||||
)
|
||||
| URegOp (urop, r1, r3) :: tl -> (
|
||||
match urop with
|
||||
| Copy -> (
|
||||
let n = RegisterMap.find {index = r1.index} prg.registers in
|
||||
helper {prg with registers = RegisterMap.add {index = r3.index} n prg.registers} tl current_label
|
||||
)
|
||||
| Not -> (
|
||||
let n = Utility.int_not
|
||||
(RegisterMap.find {index = r1.index} prg.registers)
|
||||
in
|
||||
helper {prg with registers = RegisterMap.add {index = r3.index} n prg.registers} tl current_label
|
||||
)
|
||||
| Rand -> (
|
||||
let n = Random.int
|
||||
(RegisterMap.find {index = r1.index} prg.registers)
|
||||
in
|
||||
helper {prg with registers = RegisterMap.add {index = r3.index} n prg.registers} tl current_label
|
||||
)
|
||||
)
|
||||
| Load (r1, r3) :: tl -> (
|
||||
let n = MemoryMap.find
|
||||
(RegisterMap.find {index = r1.index} prg.registers)
|
||||
prg.memory
|
||||
in
|
||||
helper {prg with registers = RegisterMap.add {index = r3.index} n prg.registers} tl current_label
|
||||
)
|
||||
| LoadI (r1, i) :: tl -> (
|
||||
let n = i
|
||||
in
|
||||
helper {prg with registers = RegisterMap.add {index = r1.index} n prg.registers} tl current_label
|
||||
)
|
||||
| Store (r1, r3) :: tl -> (
|
||||
let n = RegisterMap.find {index = r1.index} prg.registers in
|
||||
let n1 = RegisterMap.find {index = r3.index} prg.registers in
|
||||
helper {prg with memory = MemoryMap.add n1 n prg.memory} tl current_label
|
||||
)
|
||||
| Jump l :: _ -> helper prg (CodeMap.find l prg.code) l
|
||||
| CJump (r, l1, l2) :: _ -> (
|
||||
let br = (RegisterMap.find {index = r.index} prg.registers) > 0 in
|
||||
if br
|
||||
then
|
||||
helper prg (CodeMap.find l1 prg.code) l1
|
||||
else
|
||||
helper prg (CodeMap.find l2 prg.code) l2
|
||||
)
|
||||
| Label _ :: tl -> helper prg tl current_label
|
||||
in
|
||||
RegisterMap.find
|
||||
{index = "out"}
|
||||
(helper prg (CodeMap.find "main" prg.code) "main").registers
|
||||
|
||||
|
||||
let reduce (prg: RISC.RISCAssembly.t) : int =
|
||||
reduce_instructions {code = convert prg;
|
||||
registers =
|
||||
RegisterMap.singleton
|
||||
{index = "in"}
|
||||
(Option.value prg.inputval ~default:0);
|
||||
memory = MemoryMap.empty} (label_order prg)
|
||||
Reference in New Issue
Block a user