From db9de5bc717be46f0ca2dc1aa975c75adca6264d Mon Sep 17 00:00:00 2001 From: pacien Date: Sun, 22 Apr 2018 20:54:32 +0200 Subject: Simplifications --- instptr.ml | 36 ++++++++++++++---------------------- reg.ml | 9 +++++---- urm.ml | 1 + 3 files changed, 20 insertions(+), 26 deletions(-) diff --git a/instptr.ml b/instptr.ml index 9e472c4..0311a00 100644 --- a/instptr.ml +++ b/instptr.ml @@ -5,42 +5,33 @@ open Common -(* Creates a pointer of instruction from an urm command list *) let instptr_mk urmcmd_list = - let rec aux urmcmd_list count acc = - match urmcmd_list with + let rec aux urmcmd_list count acc = match urmcmd_list with | [] -> acc | instr :: tail -> aux tail (count + 1) ((count, instr) :: acc) in InstPtr([], List.rev (aux urmcmd_list 0 [])) -(* Moves the pointer to the previous instruction *) let instptr_move_up = function - | InstPtr([], list2) -> InstPtr([], list2) | InstPtr(instr :: list1, list2) -> InstPtr(list1, instr :: list2) + | x -> x -(* Moves the pointer to the next instruction *) let instptr_move_down = function - | InstPtr(list1, []) -> InstPtr(list1, []) | InstPtr(list1, instr :: list2) -> InstPtr(instr :: list1, list2) + | x -> x -(* Returns the couple from the current pointer position : (line, instruction) where instruction is an urm command or fails if there is no instruction pointed *) let instptr_get = function - | InstPtr(list1, (l, Zero(a)) :: tail)-> (l, Zero(a)) - | InstPtr(list1, (l, Succ(a)) :: tail) -> (l, Succ(a)) - | InstPtr(list1, (l, Copy(a, b)) :: tail) -> (l, Copy(a, b)) - | InstPtr(list1, (l, Jump(a, b, c)) :: tail) -> (l, Jump(a, b, c)) - | InstPtr(_, [])-> failwith "No instruction left" + | InstPtr(_, x :: _) -> x + | InstPtr(_, []) -> failwith "No instruction left" -(* Converts the current instruction pointed into a string (line and instruction formatted). If there is no instruction, returns "null" *) let instptr_string instptr = - let aux = function - | l, Zero(a) -> (string_of_int l) ^ ": Zero " ^ (string_of_int a) - | l, Succ(a) -> (string_of_int l) ^ ": Succ " ^ (string_of_int a) - | l, Copy(a, b) -> (string_of_int l) ^ ": Copy " ^ (string_of_int a) ^ " " ^ (string_of_int b) - | l, Jump(a, b, c) -> (string_of_int l) ^ ": Jump " ^ (string_of_int a) ^ " " ^ (string_of_int b) ^ " " ^ (string_of_int c) - in try aux (instptr_get instptr) with _ -> "null" - -(* Returns true if the instruction pointer is not pointing on any instruction (end of the instruction list) *) + let string_of_inst = function + | Zero(a) -> "Zero " ^ (string_of_int a) + | Succ(a) -> "Succ " ^ (string_of_int a) + | Copy(a, b) -> "Copy " ^ (string_of_int a) ^ " " ^ (string_of_int b) + | Jump(a, b, c) -> "Jump " ^ (string_of_int a) ^ " " ^ (string_of_int b) ^ " " ^ (string_of_int c) + in let string_of_instptr (l, inst) = (string_of_int l) ^ ": " ^ string_of_inst inst + in try string_of_instptr (instptr_get instptr) with _ -> "null" + let instptr_end = function | InstPtr(_, []) -> true | _ -> false @@ -49,3 +40,4 @@ let rec instptr_jump ptr offset = match offset with | 0 -> ptr | _ when offset > 0 -> instptr_jump (instptr_move_up ptr) (offset - 1) | _ -> instptr_jump (instptr_move_down ptr) (offset + 1) + diff --git a/reg.ml b/reg.ml index b27a868..c452282 100644 --- a/reg.ml +++ b/reg.ml @@ -7,10 +7,11 @@ open Common let reg_idx (Reg(idx, _)) = idx let reg_val (Reg(_, value)) = value -let reg_compar reg1 reg2 = (reg_val reg1) - (reg_val reg2) +let reg_compar l r = (reg_val l) - (reg_val r) -let regs_get reglist idx = - List.find (fun (Reg(x,v)) -> x = idx) reglist |> reg_val +let regs_get reglist index = + List.find (fun (Reg(idx, _)) -> idx = index) reglist |> reg_val let regs_set reglist index value = - Reg(index, value) :: List.filter (fun (Reg(x, v)) -> x != index) reglist + Reg(index, value) :: List.filter (fun (Reg(idx, _)) -> idx != index) reglist + diff --git a/urm.ml b/urm.ml index 49e970b..be9f7e4 100644 --- a/urm.ml +++ b/urm.ml @@ -32,3 +32,4 @@ let urm_run_trace = urm_run (* TODO *) (* Creates an URM from a command list and a register list *) let urm_mk cmd_list reg_list = { instptr = (instptr_mk cmd_list) ; regs = reg_list } + -- cgit v1.2.3