From 97a5d3600a06e2edbd6bb6faa6fa0728add0d5d3 Mon Sep 17 00:00:00 2001 From: pacien Date: Sun, 29 Apr 2018 20:41:39 +0200 Subject: Rename URM types and fix urm_from_eurm signature --- src/common.mli | 1 - src/eurm.ml | 6 +- src/eurm.mli | 24 ++++++++ src/eurm_test.ml | 74 ++++++++++++++++++++++++ src/eurml.mli | 25 -------- src/eurml_test.ml | 75 ------------------------ src/instptr.ml | 9 ++- src/main.ml | 1 - src/parser.ml | 9 ++- src/parser.mli | 1 - src/urm.ml | 11 ++-- src/urm_test.ml | 168 +++++++++++++++++++++++++++--------------------------- 12 files changed, 198 insertions(+), 206 deletions(-) create mode 100644 src/eurm.mli create mode 100644 src/eurm_test.ml delete mode 100644 src/eurml.mli delete mode 100644 src/eurml_test.ml 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 = { type state = { todo : int } exception Syntax_error - 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 let compile_stage3 eurmcmds state = eurmcmds, state let compile_stage4 eurmcmds state = [URMZero(0)], state -let urm_from_eurm = +let urm_from_eurm eurmcmds = let chain transform (eurmcmds, compile_state) = transform eurmcmds compile_state and initial_state = 0 - in (compile_preprocess, initial_state) + in (compile_preprocess eurmcmds, initial_state) |> chain compile_stage1 |> chain compile_stage2 |> chain compile_stage3 |> chain compile_stage4 - + |> fst diff --git a/src/eurm.mli b/src/eurm.mli new file mode 100644 index 0000000..e467fd6 --- /dev/null +++ b/src/eurm.mli @@ -0,0 +1,24 @@ +(* + * UPEM / L3 / Functional programming / Project: URM + * Pacien TRAN-GIRARD, Adam NAILI + *) + +open Common + +(* Strips out comments and rewrite/enumerate labels *) +val compile_preprocess : eurmcmd list -> eurmcmd list + +(* Rewrites Dec, GEqPredicate, LEqPredicate, LTPredicate, Mult and ZeroPredicate *) +val compile_stage1 : eurmcmd list -> state -> eurmcmd list * state + +(* Rewrites Add, GTPredicate and Sub *) +val compile_stage2 : eurmcmd list -> state -> eurmcmd list * state + +(* Rewrites Goto *) +val compile_stage3 : eurmcmd list -> state -> eurmcmd list * state + +(* Rewrites Inc, EqPredicate, Label and Zero *) +val compile_stage4 : eurmcmd list -> state -> urmcmd list * state + +(* Transcompiles an EURM instruction sequence into URM *) +val urm_from_eurm : eurmcmd list -> urmcmd list diff --git a/src/eurm_test.ml b/src/eurm_test.ml new file mode 100644 index 0000000..afecf9e --- /dev/null +++ b/src/eurm_test.ml @@ -0,0 +1,74 @@ +(* + * UPEM / L3 / Functional programming / Project: URM + * Pacien TRAN-GIRARD, Adam NAILI + *) + +open Common +open Urm +open Eurm +open Kaputt.Abbreviations + +let () = + Test.add_simple_test + ~title:"example_eurm_factorial_conversion" + (fun () -> + let input_eurm = [ + Comment "Compute r1! and place the result in r1"; + ZeroPredicate (1, "r1=0"); + Goto "r1>0"; + Comment "r1 holds 0"; + Label "r1=0"; + Inc 1; + Goto "done"; + Comment "r1 holds a positive integer"; + Label "r1>0"; + Copy (2, 1); + Zero 1; + Inc 1; + Zero 3; + Inc 3; + Comment "main loop"; + Label "loop"; + Mult (1, 3); + EqPredicate (2, 3, "done"); + Inc 3; + Goto "loop"; + Label "done"; + Quit] + and expected_urm = [ + URMZero 4; + URMJump (1, 4, 4); + URMZero 8; + URMJump (8, 8, 7); + URMSucc 1; + URMZero 9; + URMJump (9, 9, 29); + URMCopy (2, 1); + URMZero 1; + URMSucc 1; + URMZero 3; + URMSucc 3; + URMCopy (5, 1); + URMZero 1; + URMZero 6; + URMJump (3, 6, 25); + URMZero 7; + URMJump (5, 7, 22); + URMSucc 1; + URMSucc 7; + URMZero 10; + URMJump (10, 10, 17); + URMSucc 6; + URMZero 11; + URMJump (11, 11, 15); + URMJump (2, 3, 29); + URMSucc 3; + URMZero 12; + URMJump (12, 12, 12); + URMZero 13; + URMJump (13, 13, 38)] + in let output_urm = urm_from_eurm input_eurm + in + Assert.is_true (output_urm = expected_urm)) + +let () = if Array.mem "run-tests" Sys.argv then Test.launch_tests () diff --git a/src/eurml.mli b/src/eurml.mli deleted file mode 100644 index 8fd8ef1..0000000 --- a/src/eurml.mli +++ /dev/null @@ -1,25 +0,0 @@ -(* - * UPEM / L3 / Functional programming / Project: URM - * Pacien TRAN-GIRARD, Adam NAILI - *) - -open Common - -(* Strips out comments and rewrite/enumerate labels *) -val compile_preprocess : eurmcmd list -> eurmcmd list - -(* Rewrites Dec, GEqPredicate, LEqPredicate, LTPredicate, Mult and ZeroPredicate *) -val compile_stage1 : eurmcmd list -> state -> eurmcmd list * state - -(* Rewrites Add, GTPredicate and Sub *) -val compile_stage2 : eurmcmd list -> state -> eurmcmd list * state - -(* Rewrites Goto *) -val compile_stage3 : eurmcmd list -> state -> eurmcmd list * state - -(* Rewrites Inc, EqPredicate, Label and Zero *) -val compile_stage4 : eurmcmd list -> state -> urmcmd list * state - -(* Transcompiles an EURM instruction sequence into URM *) -val urm_from_eurm : eurmcmd list -> urmcmd list - diff --git a/src/eurml_test.ml b/src/eurml_test.ml deleted file mode 100644 index 7dc6e5e..0000000 --- a/src/eurml_test.ml +++ /dev/null @@ -1,75 +0,0 @@ -(* - * UPEM / L3 / Functional programming / Project: URM - * Pacien TRAN-GIRARD, Adam NAILI - *) - -open Common -open Urm -open Eurm -open Kaputt.Abbreviations - -let () = - Test.add_simple_test - ~title:"example_eurm_factorial_conversion" - (fun () -> - let input_eurm = [ - Comment "Compute r1! and place the result in r1"; - ZeroPredicate (1, "r1=0"); - Goto "r1>0"; - Comment "r1 holds 0"; - Label "r1=0"; - Inc 1; - Goto "done"; - Comment "r1 holds a positive integer"; - Label "r1>0"; - Copy (2, 1); - Zero 1; - Inc 1; - Zero 3; - Inc 3; - Comment "main loop"; - Label "loop"; - Mult (1, 3); - EqPredicate (2, 3, "done"); - Inc 3; - Goto "loop"; - Label "done"; - Quit] - and expected_urm = [ - URMZero 4; - URMJump (1, 4, 4); - URMZero 8; - URMJump (8, 8, 7); - URMSucc 1; - URMZero 9; - URMJump (9, 9, 29); - URMCopy (2, 1); - URMZero 1; - URMSucc 1; - URMZero 3; - URMSucc 3; - URMCopy (5, 1); - URMZero 1; - URMZero 6; - URMJump (3, 6, 25); - URMZero 7; - URMJump (5, 7, 22); - URMSucc 1; - URMSucc 7; - URMZero 10; - URMJump (10, 10, 17); - URMSucc 6; - URMZero 11; - URMJump (11, 11, 15); - URMJump (2, 3, 29); - URMSucc 3; - URMZero 12; - URMJump (12, 12, 12); - URMZero 13; - URMJump (13, 13, 38)] - in let output_urm = urm_from_eurm input_eurm - in - Assert.is_true (output_urm = expected_urm)) - -let () = if Array.mem "run-tests" Sys.argv then Test.launch_tests () - 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 let instptr_string instptr = 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) + | URMZero(a) -> "URMZero " ^ (string_of_int a) + | URMSucc(a) -> "URMSucc " ^ (string_of_int a) + | URMCopy(a, b) -> "URMCopy " ^ (string_of_int a) ^ " " ^ (string_of_int b) + | URMJump(a, b, c) -> "URMJump " ^ (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" @@ -40,4 +40,3 @@ 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/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 | [| _; "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 | trace >" - 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 = let rec program_of_lex = function | [] -> [] | 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) + | "zero" :: arg_1 :: tail -> (URMZero (int_of_string arg_1)) :: (program_of_lex tail) + | "succ" :: arg_1 :: tail -> (URMSucc (int_of_string arg_1)) :: (program_of_lex tail) + | "copy" :: arg_1 :: arg_2 :: tail -> (URMCopy ((int_of_string arg_1), (int_of_string arg_2))) :: (program_of_lex tail) + | "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) | _ -> raise Syntax_error (* FIXME: reject multiple definition of a single register *) @@ -29,4 +29,3 @@ let rec regs_of_lex = function 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/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 (* Parses the string representation of serialized registers. *) val regs_of_string : string -> reg list - diff --git a/src/urm.ml b/src/urm.ml index 3b7068b..4802db5 100644 --- a/src/urm.ml +++ b/src/urm.ml @@ -15,11 +15,11 @@ let urm_move_down urm = { instptr = instptr_move_down urm.instptr ; regs = urm.r (* 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 } + | _, URMZero(a) -> { instptr = urm.instptr ; regs = regs_set (urm.regs) a 0 } |> urm_move_down + | _, URMCopy(a, b) when a != b -> { instptr = urm.instptr ; regs = regs_set urm.regs a (regs_get urm.regs b) } |> urm_move_down + | _, URMCopy(a, b) -> failwith "Copy from one register to itself" + | _, URMSucc(a) -> { instptr = urm.instptr ; regs = regs_set urm.regs a ((regs_get urm.regs a) + 1) } |> urm_move_down + | _, 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 } | _, _ -> { instptr = urm.instptr ; regs = urm.regs } |> urm_move_down in if instptr_end urm.instptr then urm else aux (instptr_get urm.instptr) @@ -38,4 +38,3 @@ let urm_run_trace = (* 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 } - 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 () = ~title:"example_urm_add_program" (fun () -> let input_prgm = [ - 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)] + URMZero 0; + URMZero 3; + URMJump (1, 3, 6); + URMSucc 0; + URMSucc 3; + URMJump (3, 3, 2); + URMZero 3; + URMJump (2, 3, 11); + URMSucc 0; + URMSucc 3; + URMJump (3, 3, 7)] and input_regs = [ Reg (1, 2); Reg (2, 3)] and expected_urm = { instptr = InstPtr ([], [ - (0, Zero 0); - (1, Zero 3); - (2, Jump (1, 3, 6)); - (3, Succ 0); - (4, Succ 3); - (5, Jump (3, 3, 2)); - (6, Zero 3); - (7, Jump (2, 3, 11)); - (8, Succ 0); - (9, Succ 3); - (10, Jump (3, 3, 7))]); + (0, URMZero 0); + (1, URMZero 3); + (2, URMJump (1, 3, 6)); + (3, URMSucc 0); + (4, URMSucc 3); + (5, URMJump (3, 3, 2)); + (6, URMZero 3); + (7, URMJump (2, 3, 11)); + (8, URMSucc 0); + (9, URMSucc 3); + (10, URMJump (3, 3, 7))]); regs = [ Reg (1, 2); Reg (2, 3)]} @@ -60,72 +60,72 @@ let () = ~title:"example_urm_factorial_program" (fun () -> let input_prgm = [ - Zero 4; - Jump (1, 4, 4); - Zero 8; - Jump (8, 8, 7); - Succ 1; - Zero 9; - Jump (9, 9, 29); - Copy (2, 1); - Zero 1; - Succ 1; - Zero 3; - Succ 3; - Copy (5, 1); - Zero 1; - Zero 6; - Jump (3, 6, 25); - Zero 7; - Jump (5, 7, 22); - Succ 1; - Succ 7; - Zero 10; - Jump (10, 10, 17); - Succ 6; - Zero 11; - Jump (11, 11, 15); - Jump (2, 3, 29); - Succ 3; - Zero 12; - Jump (12, 12, 12); - Zero 13; - Jump (13, 13, 38)] + URMZero 4; + URMJump (1, 4, 4); + URMZero 8; + URMJump (8, 8, 7); + URMSucc 1; + URMZero 9; + URMJump (9, 9, 29); + URMCopy (2, 1); + URMZero 1; + URMSucc 1; + URMZero 3; + URMSucc 3; + URMCopy (5, 1); + URMZero 1; + URMZero 6; + URMJump (3, 6, 25); + URMZero 7; + URMJump (5, 7, 22); + URMSucc 1; + URMSucc 7; + URMZero 10; + URMJump (10, 10, 17); + URMSucc 6; + URMZero 11; + URMJump (11, 11, 15); + URMJump (2, 3, 29); + URMSucc 3; + URMZero 12; + URMJump (12, 12, 12); + URMZero 13; + URMJump (13, 13, 38)] and input_regs = [ Reg (1, 5)] and expected_urm = { instptr = InstPtr ([], [ - (0, Zero 4); - (1, Jump (1, 4, 4)); - (2, Zero 8); - (3, Jump (8, 8, 7)); - (4, Succ 1); - (5, Zero 9); - (6, Jump (9, 9, 29)); - (7, Copy (2, 1)); - (8, Zero 1); - (9, Succ 1); - (10, Zero 3); - (11, Succ 3); - (12, Copy (5, 1)); - (13, Zero 1); - (14, Zero 6); - (15, Jump (3, 6, 25)); - (16, Zero 7); - (17, Jump (5, 7, 22)); - (18, Succ 1); - (19, Succ 7); - (20, Zero 10); - (21, Jump (10, 10, 17)); - (22, Succ 6); - (23, Zero 11); - (24, Jump (11, 11, 15)); - (25, Jump (2, 3, 29)); - (26, Succ 3); - (27, Zero 12); - (28, Jump (12, 12, 12)); - (29, Zero 13); - (30, Jump (13, 13, 38))]); + (0, URMZero 4); + (1, URMJump (1, 4, 4)); + (2, URMZero 8); + (3, URMJump (8, 8, 7)); + (4, URMSucc 1); + (5, URMZero 9); + (6, URMJump (9, 9, 29)); + (7, URMCopy (2, 1)); + (8, URMZero 1); + (9, URMSucc 1); + (10, URMZero 3); + (11, URMSucc 3); + (12, URMCopy (5, 1)); + (13, URMZero 1); + (14, URMZero 6); + (15, URMJump (3, 6, 25)); + (16, URMZero 7); + (17, URMJump (5, 7, 22)); + (18, URMSucc 1); + (19, URMSucc 7); + (20, URMZero 10); + (21, URMJump (10, 10, 17)); + (22, URMSucc 6); + (23, URMZero 11); + (24, URMJump (11, 11, 15)); + (25, URMJump (2, 3, 29)); + (26, URMSucc 3); + (27, URMZero 12); + (28, URMJump (12, 12, 12)); + (29, URMZero 13); + (30, URMJump (13, 13, 38))]); regs = [ Reg (1, 5)]} and expected_output = [ -- cgit v1.2.3