diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/common.mli | 1 | ||||
-rw-r--r-- | src/eurm.ml | 6 | ||||
-rw-r--r-- | src/eurm.mli (renamed from src/eurml.mli) | 1 | ||||
-rw-r--r-- | src/eurm_test.ml (renamed from src/eurml_test.ml) | 1 | ||||
-rw-r--r-- | src/instptr.ml | 9 | ||||
-rw-r--r-- | src/main.ml | 1 | ||||
-rw-r--r-- | src/parser.ml | 9 | ||||
-rw-r--r-- | src/parser.mli | 1 | ||||
-rw-r--r-- | src/urm.ml | 11 | ||||
-rw-r--r-- | src/urm_test.ml | 168 |
10 files changed, 100 insertions, 108 deletions
diff --git a/src/common.mli b/src/common.mli index 4fa838d..1e32d57 100644 --- a/src/common.mli +++ b/src/common.mli | |||
@@ -44,4 +44,3 @@ type urm = { | |||
44 | type state = { todo : int } | 44 | type state = { todo : int } |
45 | 45 | ||
46 | exception Syntax_error | 46 | exception Syntax_error |
47 | |||
diff --git a/src/eurm.ml b/src/eurm.ml index c571384..7d6c2c6 100644 --- a/src/eurm.ml +++ b/src/eurm.ml | |||
@@ -11,12 +11,12 @@ let compile_stage2 eurmcmds state = eurmcmds, state | |||
11 | let compile_stage3 eurmcmds state = eurmcmds, state | 11 | let compile_stage3 eurmcmds state = eurmcmds, state |
12 | let compile_stage4 eurmcmds state = [URMZero(0)], state | 12 | let compile_stage4 eurmcmds state = [URMZero(0)], state |
13 | 13 | ||
14 | let urm_from_eurm = | 14 | let urm_from_eurm eurmcmds = |
15 | let chain transform (eurmcmds, compile_state) = transform eurmcmds compile_state | 15 | let chain transform (eurmcmds, compile_state) = transform eurmcmds compile_state |
16 | and initial_state = 0 | 16 | and initial_state = 0 |
17 | in (compile_preprocess, initial_state) | 17 | in (compile_preprocess eurmcmds, initial_state) |
18 | |> chain compile_stage1 | 18 | |> chain compile_stage1 |
19 | |> chain compile_stage2 | 19 | |> chain compile_stage2 |
20 | |> chain compile_stage3 | 20 | |> chain compile_stage3 |
21 | |> chain compile_stage4 | 21 | |> chain compile_stage4 |
22 | 22 | |> fst | |
diff --git a/src/eurml.mli b/src/eurm.mli index 8fd8ef1..e467fd6 100644 --- a/src/eurml.mli +++ b/src/eurm.mli | |||
@@ -22,4 +22,3 @@ val compile_stage4 : eurmcmd list -> state -> urmcmd list * state | |||
22 | 22 | ||
23 | (* Transcompiles an EURM instruction sequence into URM *) | 23 | (* Transcompiles an EURM instruction sequence into URM *) |
24 | val urm_from_eurm : eurmcmd list -> urmcmd list | 24 | val urm_from_eurm : eurmcmd list -> urmcmd list |
25 | |||
diff --git a/src/eurml_test.ml b/src/eurm_test.ml index 7dc6e5e..afecf9e 100644 --- a/src/eurml_test.ml +++ b/src/eurm_test.ml | |||
@@ -72,4 +72,3 @@ let () = | |||
72 | Assert.is_true (output_urm = expected_urm)) | 72 | Assert.is_true (output_urm = expected_urm)) |
73 | 73 | ||
74 | let () = if Array.mem "run-tests" Sys.argv then Test.launch_tests () | 74 | let () = if Array.mem "run-tests" Sys.argv then Test.launch_tests () |
75 | |||
diff --git a/src/instptr.ml b/src/instptr.ml index 0311a00..9006b66 100644 --- a/src/instptr.ml +++ b/src/instptr.ml | |||
@@ -25,10 +25,10 @@ let instptr_get = function | |||
25 | 25 | ||
26 | let instptr_string instptr = | 26 | let instptr_string instptr = |
27 | let string_of_inst = function | 27 | let string_of_inst = function |
28 | | Zero(a) -> "Zero " ^ (string_of_int a) | 28 | | URMZero(a) -> "URMZero " ^ (string_of_int a) |
29 | | Succ(a) -> "Succ " ^ (string_of_int a) | 29 | | URMSucc(a) -> "URMSucc " ^ (string_of_int a) |
30 | | Copy(a, b) -> "Copy " ^ (string_of_int a) ^ " " ^ (string_of_int b) | 30 | | URMCopy(a, b) -> "URMCopy " ^ (string_of_int a) ^ " " ^ (string_of_int b) |
31 | | Jump(a, b, c) -> "Jump " ^ (string_of_int a) ^ " " ^ (string_of_int b) ^ " " ^ (string_of_int c) | 31 | | URMJump(a, b, c) -> "URMJump " ^ (string_of_int a) ^ " " ^ (string_of_int b) ^ " " ^ (string_of_int c) |
32 | in let string_of_instptr (l, inst) = (string_of_int l) ^ ": " ^ string_of_inst inst | 32 | in let string_of_instptr (l, inst) = (string_of_int l) ^ ": " ^ string_of_inst inst |
33 | in try string_of_instptr (instptr_get instptr) with _ -> "null" | 33 | in try string_of_instptr (instptr_get instptr) with _ -> "null" |
34 | 34 | ||
@@ -40,4 +40,3 @@ let rec instptr_jump ptr offset = match offset with | |||
40 | | 0 -> ptr | 40 | | 0 -> ptr |
41 | | _ when offset > 0 -> instptr_jump (instptr_move_up ptr) (offset - 1) | 41 | | _ when offset > 0 -> instptr_jump (instptr_move_up ptr) (offset - 1) |
42 | | _ -> instptr_jump (instptr_move_down ptr) (offset + 1) | 42 | | _ -> instptr_jump (instptr_move_down ptr) (offset + 1) |
43 | |||
diff --git a/src/main.ml b/src/main.ml index 2f8d57c..3e66645 100644 --- a/src/main.ml +++ b/src/main.ml | |||
@@ -27,4 +27,3 @@ let () = match Sys.argv with | |||
27 | | [| _; "run-tests" |] -> () (* handled in test files *) | 27 | | [| _; "run-tests" |] -> () (* handled in test files *) |
28 | | [| _; mode; prgm; regs |] -> run (run_mode_of_string mode) (read_prgm prgm) (read_regs regs) | 28 | | [| _; mode; prgm; regs |] -> run (run_mode_of_string mode) (read_prgm prgm) (read_regs regs) |
29 | | _ -> print_endline "Usage: urm <run-tests | run <prgmfile> <regfile> | trace <prgmfile> <regfile>>" | 29 | | _ -> print_endline "Usage: urm <run-tests | run <prgmfile> <regfile> | trace <prgmfile> <regfile>>" |
30 | |||
diff --git a/src/parser.ml b/src/parser.ml index 1f367d1..0bc1be6 100644 --- a/src/parser.ml +++ b/src/parser.ml | |||
@@ -14,10 +14,10 @@ let rec string_of_file f = | |||
14 | let rec program_of_lex = function | 14 | let rec program_of_lex = function |
15 | | [] -> [] | 15 | | [] -> [] |
16 | | instr :: tail -> match (String.lowercase_ascii instr) :: tail with | 16 | | instr :: tail -> match (String.lowercase_ascii instr) :: tail with |
17 | | "zero" :: arg_1 :: tail -> (Zero (int_of_string arg_1)) :: (program_of_lex tail) | 17 | | "zero" :: arg_1 :: tail -> (URMZero (int_of_string arg_1)) :: (program_of_lex tail) |
18 | | "succ" :: arg_1 :: tail -> (Succ (int_of_string arg_1)) :: (program_of_lex tail) | 18 | | "succ" :: arg_1 :: tail -> (URMSucc (int_of_string arg_1)) :: (program_of_lex tail) |
19 | | "copy" :: arg_1 :: arg_2 :: tail -> (Copy ((int_of_string arg_1), (int_of_string arg_2))) :: (program_of_lex tail) | 19 | | "copy" :: arg_1 :: arg_2 :: tail -> (URMCopy ((int_of_string arg_1), (int_of_string arg_2))) :: (program_of_lex tail) |
20 | | "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) | 20 | | "jump" :: arg_1 :: arg_2 :: arg_3 :: tail -> (URMJump ((int_of_string arg_1), (int_of_string arg_2), (int_of_string arg_3))) :: (program_of_lex tail) |
21 | | _ -> raise Syntax_error | 21 | | _ -> raise Syntax_error |
22 | 22 | ||
23 | (* FIXME: reject multiple definition of a single register *) | 23 | (* FIXME: reject multiple definition of a single register *) |
@@ -29,4 +29,3 @@ let rec regs_of_lex = function | |||
29 | let seq_from_string lexer_func str = Str.split (Str.regexp "[\t\n(), ]+") str |> lexer_func | 29 | let seq_from_string lexer_func str = Str.split (Str.regexp "[\t\n(), ]+") str |> lexer_func |
30 | let program_of_string = seq_from_string program_of_lex | 30 | let program_of_string = seq_from_string program_of_lex |
31 | let regs_of_string = seq_from_string regs_of_lex | 31 | let regs_of_string = seq_from_string regs_of_lex |
32 | |||
diff --git a/src/parser.mli b/src/parser.mli index f7609f9..21fc940 100644 --- a/src/parser.mli +++ b/src/parser.mli | |||
@@ -19,4 +19,3 @@ val program_of_string : string -> urmcmd list | |||
19 | 19 | ||
20 | (* Parses the string representation of serialized registers. *) | 20 | (* Parses the string representation of serialized registers. *) |
21 | val regs_of_string : string -> reg list | 21 | val regs_of_string : string -> reg list |
22 | |||
@@ -15,11 +15,11 @@ let urm_move_down urm = { instptr = instptr_move_down urm.instptr ; regs = urm.r | |||
15 | (* Applies the current instruction pointed by the pointer of instruction. Modifies the pointer of instruction for every instruction *) | 15 | (* Applies the current instruction pointed by the pointer of instruction. Modifies the pointer of instruction for every instruction *) |
16 | let urm_apply urm = | 16 | let urm_apply urm = |
17 | let aux = function | 17 | let aux = function |
18 | | _, Zero(a) -> { instptr = urm.instptr ; regs = regs_set (urm.regs) a 0 } |> urm_move_down | 18 | | _, URMZero(a) -> { instptr = urm.instptr ; regs = regs_set (urm.regs) a 0 } |> urm_move_down |
19 | | _, Copy(a, b) when a != b -> { instptr = urm.instptr ; regs = regs_set urm.regs a (regs_get urm.regs b) } |> urm_move_down | 19 | | _, URMCopy(a, b) when a != b -> { instptr = urm.instptr ; regs = regs_set urm.regs a (regs_get urm.regs b) } |> urm_move_down |
20 | | _, Copy(a, b) -> failwith "Copy from one register to itself" | 20 | | _, URMCopy(a, b) -> failwith "Copy from one register to itself" |
21 | | _, Succ(a) -> { instptr = urm.instptr ; regs = regs_set urm.regs a ((regs_get urm.regs a) + 1) } |> urm_move_down | 21 | | _, URMSucc(a) -> { instptr = urm.instptr ; regs = regs_set urm.regs a ((regs_get urm.regs a) + 1) } |> urm_move_down |
22 | | _, 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 } | 22 | | _, URMJump(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 } |
23 | | _, _ -> { instptr = urm.instptr ; regs = urm.regs } |> urm_move_down | 23 | | _, _ -> { instptr = urm.instptr ; regs = urm.regs } |> urm_move_down |
24 | in if instptr_end urm.instptr then urm else aux (instptr_get urm.instptr) | 24 | in if instptr_end urm.instptr then urm else aux (instptr_get urm.instptr) |
25 | 25 | ||
@@ -38,4 +38,3 @@ let urm_run_trace = | |||
38 | 38 | ||
39 | (* Creates an URM from a command list and a register list *) | 39 | (* Creates an URM from a command list and a register list *) |
40 | let urm_mk cmd_list reg_list = { instptr = (instptr_mk cmd_list) ; regs = reg_list } | 40 | let urm_mk cmd_list reg_list = { instptr = (instptr_mk cmd_list) ; regs = reg_list } |
41 | |||
diff --git a/src/urm_test.ml b/src/urm_test.ml index f223bf6..bf620e0 100644 --- a/src/urm_test.ml +++ b/src/urm_test.ml | |||
@@ -14,33 +14,33 @@ let () = | |||
14 | ~title:"example_urm_add_program" | 14 | ~title:"example_urm_add_program" |
15 | (fun () -> | 15 | (fun () -> |
16 | let input_prgm = [ | 16 | let input_prgm = [ |
17 | Zero 0; | 17 | URMZero 0; |
18 | Zero 3; | 18 | URMZero 3; |
19 | Jump (1, 3, 6); | 19 | URMJump (1, 3, 6); |
20 | Succ 0; | 20 | URMSucc 0; |
21 | Succ 3; | 21 | URMSucc 3; |
22 | Jump (3, 3, 2); | 22 | URMJump (3, 3, 2); |
23 | Zero 3; | 23 | URMZero 3; |
24 | Jump (2, 3, 11); | 24 | URMJump (2, 3, 11); |
25 | Succ 0; | 25 | URMSucc 0; |
26 | Succ 3; | 26 | URMSucc 3; |
27 | Jump (3, 3, 7)] | 27 | URMJump (3, 3, 7)] |
28 | and input_regs = [ | 28 | and input_regs = [ |
29 | Reg (1, 2); | 29 | Reg (1, 2); |
30 | Reg (2, 3)] | 30 | Reg (2, 3)] |
31 | and expected_urm = { | 31 | and expected_urm = { |
32 | instptr = InstPtr ([], [ | 32 | instptr = InstPtr ([], [ |
33 | (0, Zero 0); | 33 | (0, URMZero 0); |
34 | (1, Zero 3); | 34 | (1, URMZero 3); |
35 | (2, Jump (1, 3, 6)); | 35 | (2, URMJump (1, 3, 6)); |
36 | (3, Succ 0); | 36 | (3, URMSucc 0); |
37 | (4, Succ 3); | 37 | (4, URMSucc 3); |
38 | (5, Jump (3, 3, 2)); | 38 | (5, URMJump (3, 3, 2)); |
39 | (6, Zero 3); | 39 | (6, URMZero 3); |
40 | (7, Jump (2, 3, 11)); | 40 | (7, URMJump (2, 3, 11)); |
41 | (8, Succ 0); | 41 | (8, URMSucc 0); |
42 | (9, Succ 3); | 42 | (9, URMSucc 3); |
43 | (10, Jump (3, 3, 7))]); | 43 | (10, URMJump (3, 3, 7))]); |
44 | regs = [ | 44 | regs = [ |
45 | Reg (1, 2); | 45 | Reg (1, 2); |
46 | Reg (2, 3)]} | 46 | Reg (2, 3)]} |
@@ -60,72 +60,72 @@ let () = | |||
60 | ~title:"example_urm_factorial_program" | 60 | ~title:"example_urm_factorial_program" |
61 | (fun () -> | 61 | (fun () -> |
62 | let input_prgm = [ | 62 | let input_prgm = [ |
63 | Zero 4; | 63 | URMZero 4; |
64 | Jump (1, 4, 4); | 64 | URMJump (1, 4, 4); |
65 | Zero 8; | 65 | URMZero 8; |
66 | Jump (8, 8, 7); | 66 | URMJump (8, 8, 7); |
67 | Succ 1; | 67 | URMSucc 1; |
68 | Zero 9; | 68 | URMZero 9; |
69 | Jump (9, 9, 29); | 69 | URMJump (9, 9, 29); |
70 | Copy (2, 1); | 70 | URMCopy (2, 1); |
71 | Zero 1; | 71 | URMZero 1; |
72 | Succ 1; | 72 | URMSucc 1; |
73 | Zero 3; | 73 | URMZero 3; |
74 | Succ 3; | 74 | URMSucc 3; |
75 | Copy (5, 1); | 75 | URMCopy (5, 1); |
76 | Zero 1; | 76 | URMZero 1; |
77 | Zero 6; | 77 | URMZero 6; |
78 | Jump (3, 6, 25); | 78 | URMJump (3, 6, 25); |
79 | Zero 7; | 79 | URMZero 7; |
80 | Jump (5, 7, 22); | 80 | URMJump (5, 7, 22); |
81 | Succ 1; | 81 | URMSucc 1; |
82 | Succ 7; | 82 | URMSucc 7; |
83 | Zero 10; | 83 | URMZero 10; |
84 | Jump (10, 10, 17); | 84 | URMJump (10, 10, 17); |
85 | Succ 6; | 85 | URMSucc 6; |
86 | Zero 11; | 86 | URMZero 11; |
87 | Jump (11, 11, 15); | 87 | URMJump (11, 11, 15); |
88 | Jump (2, 3, 29); | 88 | URMJump (2, 3, 29); |
89 | Succ 3; | 89 | URMSucc 3; |
90 | Zero 12; | 90 | URMZero 12; |
91 | Jump (12, 12, 12); | 91 |