1 files changed, 86 insertions, 90 deletions

diff --git a/projet.ml b/projet.ml
index 1391508..1de9e53 100644
--- a/projet.ml
+++ b/projet.ml
@@ -1,128 +1,124 @@
 #load "str.cma";;
-open List;;
-(*line number*)
+
+open List
+
 type line = int
-(*register index*)
 type regidx = int
-(*register value*)
 type regval = int
-(*register*)
 type reg = Reg of regidx * regval
-(*URM instruction*)
+
 type urmcmd =
-|Copy of regidx * regidx
-|Jump of regidx * regidx * line
-|Succ of regidx
-|Zero of regidx
-(*instruction pointer*)
+  | Copy of regidx * regidx
+  | Jump of regidx * regidx * line
+  | Succ of regidx
+  | Zero of regidx
+
 type instptr = InstPtr of (line * urmcmd) list * (line * urmcmd) list
-(*URM*)
-type urm = {instptr : instptr; regs : reg list}
+
+type urm = {
+  instptr : instptr;
+  regs : reg list
+}
 
 exception Syntax_error
 
 let rec string_of_file f =
-        try
-                let str = input_line f
-          in str ^ " " ^ (string_of_file f)
-        with
-        | End_of_file -> ""
-
-let rec program_of_lex lex =
-        match lex with
-                |[] -> []
-                |"zero" :: arg_1 :: tail ->(Zero (int_of_string arg_1)) :: (program_of_lex tail)
-                |"succ" :: arg_1 :: tail -> (Succ (int_of_string arg_1)) :: (program_of_lex tail)
-                |"copy" :: arg_1 :: arg_2 :: tail -> (Copy ((int_of_string arg_1), (int_of_string arg_2))):: (program_of_lex tail)
-                |"jump" :: arg_1 :: arg_2 :: arg_3 :: tail ->(Jump ((int_of_string arg_1), (int_of_string arg_2),(int_of_string arg_3))):: (program_of_lex tail)
-                |_ -> raise Syntax_error
+  try
+    let str = input_line f
+    in str ^ " " ^ (string_of_file f)
+  with End_of_file -> ""
+
+let rec program_of_lex = function
+  | [] -> []
+  | "zero" :: arg_1 :: tail -> (Zero (int_of_string arg_1)) :: (program_of_lex tail)
+  | "succ" :: arg_1 :: tail -> (Succ (int_of_string arg_1)) :: (program_of_lex tail)
+  | "copy" :: arg_1 :: arg_2 :: tail -> (Copy ((int_of_string arg_1), (int_of_string arg_2))) :: (program_of_lex tail)
+  | "jump" :: arg_1 :: arg_2 :: arg_3 :: tail -> (Jump ((int_of_string arg_1), (int_of_string arg_2), (int_of_string arg_3))) :: (program_of_lex tail)
+  | _ -> raise Syntax_error
 
 let program_of_string str =
-        let lex = Str.split (Str.regexp "[\t\n(),]+") str
-        in List.iter (fun s -> print_string s; print_newline ()) lex; program_of_lex lex
+  let lex = Str.split (Str.regexp "[\t\n(),]+") str
+  in List.iter (fun s -> print_string s; print_newline ()) lex; program_of_lex lex
 
-(*Creates a pointer of instruction from an urm command list*)
+(* 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
-                | [] -> acc
-                | instruction::reste -> aux reste (count + 1) ((count,instruction)::acc)
-        in InstPtr([],rev (aux urmcmd_list 0 []))
+  let rec aux urmcmd_list count acc =
+    match urmcmd_list with
+    | [] -> acc
+    | instr :: tail -> aux tail (count + 1) ((count, instr) :: acc)
+  in InstPtr([], rev (aux urmcmd_list 0 []))
 
-(*Moves the pointer to the previous instruction*)
+(* Moves the pointer to the previous instruction *)
 let instptr_move_up = function
-        | InstPtr([],list2)-> InstPtr([],list2)
-        | InstPtr(instr::list1,list2) -> InstPtr(list1, instr::list2)
+  | InstPtr([], list2) -> InstPtr([], list2)
+  | InstPtr(instr :: list1, list2) -> InstPtr(list1, instr :: list2)
 
-(*Moves the pointer to the next instruction*)
+(* Moves the pointer to the next instruction *)
 let instptr_move_down = function
-        | InstPtr(list1,[])-> InstPtr(list1,[])
-        | InstPtr(list1,instr::list2) -> InstPtr(instr::list1, list2)
+  | InstPtr(list1, []) -> InstPtr(list1, [])
+  | InstPtr(list1, instr :: list2) -> InstPtr(instr :: list1, list2)
 
-(*Returns the couple from the current pointer position : (line,instruction) where instruction is an urm command or fails if there is no instruction pointed*)
+(* 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(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"
 
-(*Converts the current instruction pointed into a string (line and instruction formatted). If there is no instruction, returns "null"*)
+(* 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 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 instptr_end = function
-        | InstPtr(_,[]) -> true
-        | _ -> false
-
-(*Returns the pointer of instruction after a jump decided by the given offset*)
-let rec instptr_jump ptr offset =
-if offset = 0 then ptr else
-        if offset > 0 then instptr_jump (instptr_move_up ptr) (offset-1)
-        else instptr_jump (instptr_move_down ptr) (offset+1)
+  | InstPtr(_, []) -> true
+  | _ -> false
 
+(* Returns the pointer of instruction after a jump decided by the given offse t*)
+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)
 
 let reg_idx (Reg(idx, _)) = idx
-
 let reg_val (Reg(_, value)) = value
 
-(*Compares two registers. Returns -1 if reg1 is lower than reg2, 1 if it is greater than reg2 or 0 if both are equals.*)
+(* Compares two registers. Returns -1 if reg1 is lower than reg2, 1 if it is greater than reg2 or 0 if both are equals. *)
 let reg_compar reg1 reg2 = (reg_val reg1) - (reg_val reg2)
 
-(*Returns the value contained in the specified register in a register list*)
-let regs_get reglist idx = List.find (fun (Reg(x,v)) -> x=idx) reglist |> reg_val
+(* Returns the value contained in the specified register in a register list *)
+let regs_get reglist idx = List.find (fun (Reg(x,v)) -> x = idx) reglist |> reg_val
 
-(*Set the value of the register to value, or creates it to the value specified if it does not exist*)
-let regs_set reglist index value = Reg(index,value)::(List.filter (fun (Reg(x,v))-> x!=index) reglist)
+(* Set the value of the register to value, or creates it to the value specified if it does not exist *)
+let regs_set reglist index value = Reg(index, value) :: List.filter (fun (Reg(x, v)) -> x != index) reglist
 
-(*Gives a new urm by moving down its instruction pointer*)
-let urm_move_down urm = {instptr = (instptr_move_down urm.instptr); regs = urm.regs}
+(* Gives a new urm by moving down its instruction pointer *)
+let urm_move_down urm = { instptr = instptr_move_down urm.instptr ; regs = urm.regs }
 
+(* TODO: Verifier pour JUMP que a et b sont deux registres initialisés *)
 
-(*TODO: Verifier pour JUMP que a et b sont deux registres initialisés*)
-
-(*Applies the current instruction pointed by the pointer of instruction. Modifies the pointer of instruction for every instruction*)
+(* Applies the current instruction pointed by the pointer of instruction. Modifies the pointer of instruction for every instruction *)
 let urm_apply urm =
-        let aux = function
-                | _,Zero(a) -> {instptr = urm.instptr ; regs = regs_set (urm.regs) a 0} |> urm_move_down
-                | _,Copy(a,b) when a!=b -> {instptr = urm.instptr ; regs = regs_set urm.regs a (regs_get urm.regs b)} |> urm_move_down
-                | _,Copy(a,b) -> failwith "Copy from one register to itself"
-                | _,Succ(a) -> {instptr = urm.instptr ; regs = regs_set urm.regs a ((regs_get urm.regs a)+1)} |> urm_move_down
-                | _,Jump(a,b,c) when (regs_get urm.regs a)=(regs_get urm.regs b)-> {instptr = (instptr_jump urm.instptr (fst (instptr_get urm.instptr) - c)); regs = urm.regs}
-                | _,_-> {instptr = urm.instptr; regs = urm.regs} |> urm_move_down
-        in if instptr_end urm.instptr then urm else aux (instptr_get urm.instptr)
-
-(*Launches the URM*)
+  let aux = function
+    | _, Zero(a) -> { instptr = urm.instptr ; regs = regs_set (urm.regs) a 0 } |> urm_move_down
+    | _, Copy(a, b) when a != b -> { instptr = urm.instptr ; regs = regs_set urm.regs a (regs_get urm.regs b) } |> urm_move_down
+    | _, Copy(a, b) -> failwith "Copy from one register to itself"
+    | _, Succ(a) -> { instptr = urm.instptr ; regs = regs_set urm.regs a ((regs_get urm.regs a) + 1) } |> urm_move_down
+    | _, Jump(a, b, c) when (regs_get urm.regs a) = (regs_get urm.regs b) -> { instptr = (instptr_jump urm.instptr (fst (instptr_get urm.instptr) - c)) ; regs = urm.regs }
+    | _, _ -> { instptr = urm.instptr ; regs = urm.regs } |> urm_move_down
+  in if instptr_end urm.instptr then urm else aux (instptr_get urm.instptr)
+
+(* Launches the URM *)
 let rec urm_run = function
-        | {instptr = InstPtr(_,[]); regs = reg_list } -> reg_list
-        | urm -> urm_apply urm |> urm_run
+  | { instptr = InstPtr(_, []) ; regs = reg_list } -> reg_list
+  | urm -> urm_apply urm |> urm_run
+
+(* 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 }
 
-(*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}