12 files changed, 101 insertions, 45 deletions

diff --git a/README.md b/README.md
index 2971b4c..2cce7bf 100644
--- a/README.md
+++ b/README.md
@@ -19,7 +19,11 @@ Unlimited Register Machine in OCaml.
 
 ## Usage
 
-TODO: describe usage of the `urm` program.
+```
+./urm <run | trace> <program file> <initial register state file>
+```
+
+Examples programs are provided in the `examples` folder.
 
 
 ## Authors
diff --git a/examples/add.reg b/examples/add.reg
new file mode 100644
index 0000000..c24e1f9
--- /dev/null
+++ b/examples/add.reg
@@ -0,0 +1,2 @@
+1 2
+2 3
diff --git a/examples/add.urm b/examples/add.urm
new file mode 100644
index 0000000..d11eff7
--- /dev/null
+++ b/examples/add.urm
@@ -0,0 +1,11 @@
+ZERO 0
+ZERO 3
+JUMP 1 3 6
+SUCC 0
+SUCC 3
+JUMP 3 3 2
+ZERO 3
+JUMP 2 3 11
+SUCC 0
+SUCC 3
+JUMP 3 3 7
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/main.ml b/main.ml
index 1bb6704..2f8d57c 100644
--- a/main.ml
+++ b/main.ml
@@ -9,3 +9,22 @@ open Instptr
 open Reg
 open Urm
 
+let exec_with_resource func filename =
+  let file = open_in filename in
+  let res = func file in
+  close_in file; res
+
+let read_prgm = exec_with_resource (fun f -> string_of_file f |> program_of_string)
+let read_regs = exec_with_resource (fun f -> string_of_file f |> regs_of_string)
+let run run_func prgm regs = urm_mk prgm regs |> run_func |> regs_string |> print_endline
+
+let run_mode_of_string = function
+  | "run" -> urm_run
+  | "trace" -> urm_run_trace
+  | _ -> failwith "Invalid run mode"
+
+let () = match Sys.argv with
+  | [| _; "run-tests" |] -> () (* handled in test files *)
+  | [| _; mode; prgm; regs |] -> run (run_mode_of_string mode) (read_prgm prgm) (read_regs regs)
+  | _ -> print_endline "Usage: urm <run-tests | run <prgmfile> <regfile> | trace <prgmfile> <regfile>>"
+
diff --git a/makefile b/makefile
index 4179bf2..6aceab8 100644
--- a/makefile
+++ b/makefile
@@ -7,7 +7,8 @@ SOURCES = \
   instptr.mli instptr.ml \
   reg.mli reg.ml \
   urm.mli urm.ml urm_test.ml \
-  eurm.mli eurm.ml eurm_test.ml
+  eurm.mli eurm.ml eurm_test.ml \
+  main.ml
 
 OCAMLMAKEFILE = /usr/share/ocamlmakefile/OCamlMakefile
 include $(OCAMLMAKEFILE)
diff --git a/parser.ml b/parser.ml
index e01208f..1f367d1 100644
--- a/parser.ml
+++ b/parser.ml
@@ -13,12 +13,20 @@ let rec string_of_file f =
 
 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)
+  | instr :: tail -> match (String.lowercase_ascii instr) :: tail 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
+
+(* FIXME: reject multiple definition of a single register *)
+let rec regs_of_lex = function
+  | [] -> []
+  | regnum :: regvalue :: tail -> Reg (int_of_string regnum, int_of_string regvalue) :: (regs_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 seq_from_string lexer_func str =  Str.split (Str.regexp "[\t\n(), ]+") str |> lexer_func
+let program_of_string = seq_from_string program_of_lex
+let regs_of_string = seq_from_string regs_of_lex
+
diff --git a/parser.mli b/parser.mli
index d210396..f7609f9 100644
--- a/parser.mli
+++ b/parser.mli
@@ -11,5 +11,12 @@ val string_of_file : in_channel -> string
 (* Converts lexemes into instructions. *)
 val program_of_lex : string list -> urmcmd list
 
+(* Converts lexemes into registers. *)
+val regs_of_lex : string list -> reg list
+
 (* Parses the string representation of a program. *)
 val program_of_string : string -> urmcmd list
+
+(* Parses the string representation of serialized registers. *)
+val regs_of_string : string -> reg list
+
diff --git a/reg.ml b/reg.ml
index b27a868..56c4ae6 100644
--- a/reg.ml
+++ b/reg.ml
@@ -7,10 +7,10 @@ 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 reg_string (Reg (index, value)) = "(" ^ (string_of_int index) ^ "," ^ (string_of_int value) ^ ")"
 
-let regs_get reglist idx =
-  List.find (fun (Reg(x,v)) -> x = idx) reglist |> reg_val
-
-let regs_set reglist index value =
-  Reg(index, value) :: List.filter (fun (Reg(x, v)) -> x != index) reglist
+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(idx, _)) -> idx != index) reglist
+let regs_sort = List.sort (fun (Reg(l, _)) (Reg(r, _)) -> compare l r)
+let regs_string reglist = regs_sort reglist |> List.map (reg_string) |> String.concat ","
diff --git a/reg.mli b/reg.mli
index 15d53de..6e81259 100644
--- a/reg.mli
+++ b/reg.mli
@@ -21,3 +21,9 @@ val regs_get : reg list -> regidx -> regval
 (* Set the value of the register to value,
  * or creates it to the value specified if it does not exist *)
 val regs_set : reg list -> regidx -> regval -> reg list
+
+(* Sorts a list of registers in ascending index order *)
+val regs_sort : reg list -> reg list
+
+(* Returns the string representation of a register list. *)
+val regs_string : reg list -> string
diff --git a/urm.ml b/urm.ml
index 49e970b..3b7068b 100644
--- a/urm.ml
+++ b/urm.ml
@@ -23,12 +23,19 @@ let urm_apply urm =
     | _, _ -> { 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
+let rec urm_run_pre pre = function
   | { instptr = InstPtr(_, []) ; regs = reg_list } -> reg_list
-  | urm -> urm_apply urm |> urm_run
+  | urm -> pre urm; urm_apply urm |> urm_run_pre pre
 
-let urm_run_trace = urm_run (* TODO *)
+let urm_run = urm_run_pre (fun _ -> ())
+
+let urm_run_trace =
+  let print_func u =
+    print_endline (instptr_string u.instptr);
+    print_endline (regs_string u.regs);
+    print_newline ()
+  in urm_run_pre (print_func)