From 0647f37eebbefb8446fc8abfc533a23952fbb8be Mon Sep 17 00:00:00 2001 From: pacien Date: Sun, 29 Apr 2018 20:24:38 +0200 Subject: Move sources to dedicated directory --- .merlin | 1 - common.ml | 1 - common.mli | 47 ----------------- eurm.ml | 22 -------- eurml.mli | 25 --------- eurml_test.ml | 75 --------------------------- instptr.ml | 43 ---------------- instptr.mli | 29 ----------- main.ml | 30 ----------- makefile | 18 ------- parser.ml | 32 ------------ parser.mli | 22 -------- reg.ml | 16 ------ reg.mli | 29 ----------- src/.merlin | 1 + src/common.ml | 1 + src/common.mli | 47 +++++++++++++++++ src/eurm.ml | 22 ++++++++ src/eurml.mli | 25 +++++++++ src/eurml_test.ml | 75 +++++++++++++++++++++++++++ src/instptr.ml | 43 ++++++++++++++++ src/instptr.mli | 29 +++++++++++ src/main.ml | 30 +++++++++++ src/makefile | 18 +++++++ src/parser.ml | 32 ++++++++++++ src/parser.mli | 22 ++++++++ src/reg.ml | 16 ++++++ src/reg.mli | 29 +++++++++++ src/urm.ml | 41 +++++++++++++++ src/urm.mli | 17 ++++++ src/urm_test.ml | 151 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ urm.ml | 41 --------------- urm.mli | 17 ------ urm_test.ml | 151 ------------------------------------------------------ 34 files changed, 599 insertions(+), 599 deletions(-) delete mode 100644 .merlin delete mode 120000 common.ml delete mode 100644 common.mli delete mode 100644 eurm.ml delete mode 100644 eurml.mli delete mode 100644 eurml_test.ml delete mode 100644 instptr.ml delete mode 100644 instptr.mli delete mode 100644 main.ml delete mode 100644 makefile delete mode 100644 parser.ml delete mode 100644 parser.mli delete mode 100644 reg.ml delete mode 100644 reg.mli create mode 100644 src/.merlin create mode 120000 src/common.ml create mode 100644 src/common.mli create mode 100644 src/eurm.ml create mode 100644 src/eurml.mli create mode 100644 src/eurml_test.ml create mode 100644 src/instptr.ml create mode 100644 src/instptr.mli create mode 100644 src/main.ml create mode 100644 src/makefile create mode 100644 src/parser.ml create mode 100644 src/parser.mli create mode 100644 src/reg.ml create mode 100644 src/reg.mli create mode 100644 src/urm.ml create mode 100644 src/urm.mli create mode 100644 src/urm_test.ml delete mode 100644 urm.ml delete mode 100644 urm.mli delete mode 100644 urm_test.ml diff --git a/.merlin b/.merlin deleted file mode 100644 index 22dd628..0000000 --- a/.merlin +++ /dev/null @@ -1 +0,0 @@ -PKG kaputt diff --git a/common.ml b/common.ml deleted file mode 120000 index ed50e6f..0000000 --- a/common.ml +++ /dev/null @@ -1 +0,0 @@ -common.mli \ No newline at end of file diff --git a/common.mli b/common.mli deleted file mode 100644 index 4fa838d..0000000 --- a/common.mli +++ /dev/null @@ -1,47 +0,0 @@ -(* - * UPEM / L3 / Functional programming / Project: URM - * Pacien TRAN-GIRARD, Adam NAILI - *) - -type line = int -type label = string -type regidx = int -type regval = int -type reg = Reg of regidx * regval - -type urmcmd = - | URMCopy of regidx * regidx - | URMJump of regidx * regidx * line - | URMSucc of regidx - | URMZero of regidx - -type eurmcmd = - | Add of regidx * regidx - | Comment of string - | Copy of regidx * regidx - | Dec of regidx - | EqPredicate of regidx * regidx * label - | GEqPredicate of regidx * regidx * label - | GTPredicate of regidx * regidx * label - | Goto of label - | Inc of regidx - | Label of label - | LEqPredicate of regidx * regidx * label - | LTPredicate of regidx * regidx * label - | Mult of regidx * regidx - | Quit - | Sub of regidx * regidx - | Zero of regidx - | ZeroPredicate of regidx * label - -type instptr = InstPtr of (line * urmcmd) list * (line * urmcmd) list - -type urm = { - instptr : instptr; - regs : reg list -} - -type state = { todo : int } - -exception Syntax_error - diff --git a/eurm.ml b/eurm.ml deleted file mode 100644 index c571384..0000000 --- a/eurm.ml +++ /dev/null @@ -1,22 +0,0 @@ -(* - * UPEM / L3 / Functional programming / Project: URM - * Pacien TRAN-GIRARD, Adam NAILI - *) - -open Common - -let compile_preprocess eurmcmds = eurmcmds -let compile_stage1 eurmcmds state = eurmcmds, state -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 chain transform (eurmcmds, compile_state) = transform eurmcmds compile_state - and initial_state = 0 - in (compile_preprocess, initial_state) - |> chain compile_stage1 - |> chain compile_stage2 - |> chain compile_stage3 - |> chain compile_stage4 - diff --git a/eurml.mli b/eurml.mli deleted file mode 100644 index 8fd8ef1..0000000 --- a/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/eurml_test.ml b/eurml_test.ml deleted file mode 100644 index 7dc6e5e..0000000 --- a/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/instptr.ml b/instptr.ml deleted file mode 100644 index 0311a00..0000000 --- a/instptr.ml +++ /dev/null @@ -1,43 +0,0 @@ -(* - * UPEM / L3 / Functional programming / Project: URM - * Pacien TRAN-GIRARD, Adam NAILI - *) - -open Common - -let instptr_mk urmcmd_list = - 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 [])) - -let instptr_move_up = function - | InstPtr(instr :: list1, list2) -> InstPtr(list1, instr :: list2) - | x -> x - -let instptr_move_down = function - | InstPtr(list1, instr :: list2) -> InstPtr(instr :: list1, list2) - | x -> x - -let instptr_get = function - | InstPtr(_, x :: _) -> x - | InstPtr(_, []) -> failwith "No instruction left" - -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) - 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 - -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/instptr.mli b/instptr.mli deleted file mode 100644 index f1252b5..0000000 --- a/instptr.mli +++ /dev/null @@ -1,29 +0,0 @@ -(* - * UPEM / L3 / Functional programming / Project: URM - * Pacien TRAN-GIRARD, Adam NAILI - *) - -open Common - -(* Create an instruction pointer for an URM program. *) -val instptr_mk : urmcmd list -> instptr - -(* Move the instruction pointer up. Do nothing if this is not possible. *) -val instptr_move_up : instptr -> instptr - -(* Move the instruction pointer down. Do nothing if this is not possible. *) -val instptr_move_down : instptr -> instptr - -(* Get the current command from the instruction pointer. - * Fail if the command pointer is not set on a valid command. *) -val instptr_get : instptr -> line * urmcmd - -(* Get the current instruction as a string. - * Returns "null" is the instruction pointer is not valid. *) -val instptr_string : instptr -> string - -(* Returns the pointer of instruction after a jump decided by the given offse t *) -val instptr_jump : instptr -> int -> instptr - -(* Returns true if the instruction pointer is not pointing on any instruction (end of the instruction list) *) -val instptr_end : instptr -> bool diff --git a/main.ml b/main.ml deleted file mode 100644 index 2f8d57c..0000000 --- a/main.ml +++ /dev/null @@ -1,30 +0,0 @@ -(* - * UPEM / L3 / Functional programming / Project: URM - * Pacien TRAN-GIRARD, Adam NAILI - *) - -open Common -open Parser -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 | trace >" - diff --git a/makefile b/makefile deleted file mode 100644 index 6aceab8..0000000 --- a/makefile +++ /dev/null @@ -1,18 +0,0 @@ -RESULT = urm -LIBS = str -PACKS = kaputt -SOURCES = \ - common.ml \ - parser.mli parser.ml \ - instptr.mli instptr.ml \ - reg.mli reg.ml \ - urm.mli urm.ml urm_test.ml \ - eurm.mli eurm.ml eurm_test.ml \ - main.ml - -OCAMLMAKEFILE = /usr/share/ocamlmakefile/OCamlMakefile -include $(OCAMLMAKEFILE) - -test: nc - ./$(RESULT) run-tests - diff --git a/parser.ml b/parser.ml deleted file mode 100644 index 1f367d1..0000000 --- a/parser.ml +++ /dev/null @@ -1,32 +0,0 @@ -(* - * UPEM / L3 / Functional programming / Project: URM - * Pacien TRAN-GIRARD, Adam NAILI - *) - -open Common - -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 = 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) - | _ -> 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 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 deleted file mode 100644 index f7609f9..0000000 --- a/parser.mli +++ /dev/null @@ -1,22 +0,0 @@ -(* - * UPEM / L3 / Functional programming / Project: URM - * Pacien TRAN-GIRARD, Adam NAILI - *) - -open Common - -(* Reads a file into a string. *) -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 deleted file mode 100644 index 56c4ae6..0000000 --- a/reg.ml +++ /dev/null @@ -1,16 +0,0 @@ -(* - * UPEM / L3 / Functional programming / Project: URM - * Pacien TRAN-GIRARD, Adam NAILI - *) - -open Common - -let reg_idx (Reg(idx, _)) = idx -let reg_val (Reg(_, value)) = value -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 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 deleted file mode 100644 index 6e81259..0000000 --- a/reg.mli +++ /dev/null @@ -1,29 +0,0 @@ -(* - * UPEM / L3 / Functional programming / Project: URM - * Pacien TRAN-GIRARD, Adam NAILI - *) - -open Common - -(* Returns the index of a register. *) -val reg_idx : reg -> regidx - -(* Compares two register Ri and Rj. - * It returns an integer less than, equal to, or greater than zero if - * the first register index is respectively less than, equal to, or - * greater than the second register index. *) -val reg_compar : reg -> reg -> int - -(* Returns the register value of a register from its index. Fails if - * there is not register with the sought register index. *) -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/src/.merlin b/src/.merlin new file mode 100644 index 0000000..22dd628 --- /dev/null +++ b/src/.merlin @@ -0,0 +1 @@ +PKG kaputt diff --git a/src/common.ml b/src/common.ml new file mode 120000 index 0000000..ed50e6f --- /dev/null +++ b/src/common.ml @@ -0,0 +1 @@ +common.mli \ No newline at end of file diff --git a/src/common.mli b/src/common.mli new file mode 100644 index 0000000..4fa838d --- /dev/null +++ b/src/common.mli @@ -0,0 +1,47 @@ +(* + * UPEM / L3 / Functional programming / Project: URM + * Pacien TRAN-GIRARD, Adam NAILI + *) + +type line = int +type label = string +type regidx = int +type regval = int +type reg = Reg of regidx * regval + +type urmcmd = + | URMCopy of regidx * regidx + | URMJump of regidx * regidx * line + | URMSucc of regidx + | URMZero of regidx + +type eurmcmd = + | Add of regidx * regidx + | Comment of string + | Copy of regidx * regidx + | Dec of regidx + | EqPredicate of regidx * regidx * label + | GEqPredicate of regidx * regidx * label + | GTPredicate of regidx * regidx * label + | Goto of label + | Inc of regidx + | Label of label + | LEqPredicate of regidx * regidx * label + | LTPredicate of regidx * regidx * label + | Mult of regidx * regidx + | Quit + | Sub of regidx * regidx + | Zero of regidx + | ZeroPredicate of regidx * label + +type instptr = InstPtr of (line * urmcmd) list * (line * urmcmd) list + +type urm = { + instptr : instptr; + regs : reg list +} + +type state = { todo : int } + +exception Syntax_error + diff --git a/src/eurm.ml b/src/eurm.ml new file mode 100644 index 0000000..c571384 --- /dev/null +++ b/src/eurm.ml @@ -0,0 +1,22 @@ +(* + * UPEM / L3 / Functional programming / Project: URM + * Pacien TRAN-GIRARD, Adam NAILI + *) + +open Common + +let compile_preprocess eurmcmds = eurmcmds +let compile_stage1 eurmcmds state = eurmcmds, state +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 chain transform (eurmcmds, compile_state) = transform eurmcmds compile_state + and initial_state = 0 + in (compile_preprocess, initial_state) + |> chain compile_stage1 + |> chain compile_stage2 + |> chain compile_stage3 + |> chain compile_stage4 + diff --git a/src/eurml.mli b/src/eurml.mli new file mode 100644 index 0000000..8fd8ef1 --- /dev/null +++ b/src/eurml.mli @@ -0,0 +1,25 @@ +(* + * 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 new file mode 100644 index 0000000..7dc6e5e --- /dev/null +++ b/src/eurml_test.ml @@ -0,0 +1,75 @@ +(* + * 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 new file mode 100644 index 0000000..0311a00 --- /dev/null +++ b/src/instptr.ml @@ -0,0 +1,43 @@ +(* + * UPEM / L3 / Functional programming / Project: URM + * Pacien TRAN-GIRARD, Adam NAILI + *) + +open Common + +let instptr_mk urmcmd_list = + 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 [])) + +let instptr_move_up = function + | InstPtr(instr :: list1, list2) -> InstPtr(list1, instr :: list2) + | x -> x + +let instptr_move_down = function + | InstPtr(list1, instr :: list2) -> InstPtr(instr :: list1, list2) + | x -> x + +let instptr_get = function + | InstPtr(_, x :: _) -> x + | InstPtr(_, []) -> failwith "No instruction left" + +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) + 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 + +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/instptr.mli b/src/instptr.mli new file mode 100644 index 0000000..f1252b5 --- /dev/null +++ b/src/instptr.mli @@ -0,0 +1,29 @@ +(* + * UPEM / L3 / Functional programming / Project: URM + * Pacien TRAN-GIRARD, Adam NAILI + *) + +open Common + +(* Create an instruction pointer for an URM program. *) +val instptr_mk : urmcmd list -> instptr + +(* Move the instruction pointer up. Do nothing if this is not possible. *) +val instptr_move_up : instptr -> instptr + +(* Move the instruction pointer down. Do nothing if this is not possible. *) +val instptr_move_down : instptr -> instptr + +(* Get the current command from the instruction pointer. + * Fail if the command pointer is not set on a valid command. *) +val instptr_get : instptr -> line * urmcmd + +(* Get the current instruction as a string. + * Returns "null" is the instruction pointer is not valid. *) +val instptr_string : instptr -> string + +(* Returns the pointer of instruction after a jump decided by the given offse t *) +val instptr_jump : instptr -> int -> instptr + +(* Returns true if the instruction pointer is not pointing on any instruction (end of the instruction list) *) +val instptr_end : instptr -> bool diff --git a/src/main.ml b/src/main.ml new file mode 100644 index 0000000..2f8d57c --- /dev/null +++ b/src/main.ml @@ -0,0 +1,30 @@ +(* + * UPEM / L3 / Functional programming / Project: URM + * Pacien TRAN-GIRARD, Adam NAILI + *) + +open Common +open Parser +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 | trace >" + diff --git a/src/makefile b/src/makefile new file mode 100644 index 0000000..6aceab8 --- /dev/null +++ b/src/makefile @@ -0,0 +1,18 @@ +RESULT = urm +LIBS = str +PACKS = kaputt +SOURCES = \ + common.ml \ + parser.mli parser.ml \ + instptr.mli instptr.ml \ + reg.mli reg.ml \ + urm.mli urm.ml urm_test.ml \ + eurm.mli eurm.ml eurm_test.ml \ + main.ml + +OCAMLMAKEFILE = /usr/share/ocamlmakefile/OCamlMakefile +include $(OCAMLMAKEFILE) + +test: nc + ./$(RESULT) run-tests + diff --git a/src/parser.ml b/src/parser.ml new file mode 100644 index 0000000..1f367d1 --- /dev/null +++ b/src/parser.ml @@ -0,0 +1,32 @@ +(* + * UPEM / L3 / Functional programming / Project: URM + * Pacien TRAN-GIRARD, Adam NAILI + *) + +open Common + +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 = 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) + | _ -> 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 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 new file mode 100644 index 0000000..f7609f9 --- /dev/null +++ b/src/parser.mli @@ -0,0 +1,22 @@ +(* + * UPEM / L3 / Functional programming / Project: URM + * Pacien TRAN-GIRARD, Adam NAILI + *) + +open Common + +(* Reads a file into a string. *) +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/src/reg.ml b/src/reg.ml new file mode 100644 index 0000000..56c4ae6 --- /dev/null +++ b/src/reg.ml @@ -0,0 +1,16 @@ +(* + * UPEM / L3 / Functional programming / Project: URM + * Pacien TRAN-GIRARD, Adam NAILI + *) + +open Common + +let reg_idx (Reg(idx, _)) = idx +let reg_val (Reg(_, value)) = value +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 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/src/reg.mli b/src/reg.mli new file mode 100644 index 0000000..6e81259 --- /dev/null +++ b/src/reg.mli @@ -0,0 +1,29 @@ +(* + * UPEM / L3 / Functional programming / Project: URM + * Pacien TRAN-GIRARD, Adam NAILI + *) + +open Common + +(* Returns the index of a register. *) +val reg_idx : reg -> regidx + +(* Compares two register Ri and Rj. + * It returns an integer less than, equal to, or greater than zero if + * the first register index is respectively less than, equal to, or + * greater than the second register index. *) +val reg_compar : reg -> reg -> int + +(* Returns the register value of a register from its index. Fails if + * there is not register with the sought register index. *) +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/src/urm.ml b/src/urm.ml new file mode 100644 index 0000000..3b7068b --- /dev/null +++ b/src/urm.ml @@ -0,0 +1,41 @@ +(* + * UPEM / L3 / Functional programming / Project: URM + * Pacien TRAN-GIRARD, Adam NAILI + *) + +open Common +open Instptr +open Reg + +(* 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 *) + +(* 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) + +let rec urm_run_pre pre = function + | { instptr = InstPtr(_, []) ; regs = reg_list } -> reg_list + | urm -> pre urm; urm_apply urm |> urm_run_pre pre + +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) + +(* 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.mli b/src/urm.mli new file mode 100644 index 0000000..1949d28 --- /dev/null +++ b/src/urm.mli @@ -0,0 +1,17 @@ +(* + * UPEM / L3 / Functional programming / Project: URM + * Pacien TRAN-GIRARD, Adam NAILI + *) + +open Common + +(* Runs an URM. + * Returns all registers when the program halts. *) +val urm_run : urm -> reg list + +(* Runs an URM in trace mode. + * Returns all registers when the program halts. *) +val urm_run_trace : urm -> reg list + +(* Makes an URM. *) +val urm_mk : urmcmd list -> reg list -> urm diff --git a/src/urm_test.ml b/src/urm_test.ml new file mode 100644 index 0000000..f223bf6 --- /dev/null +++ b/src/urm_test.ml @@ -0,0 +1,151 @@ +(* + * UPEM / L3 / Functional programming / Project: URM + * Pacien TRAN-GIRARD, Adam NAILI + *) + +open Common +open Instptr +open Urm +open Reg +open Kaputt.Abbreviations + +let () = + Test.add_simple_test + ~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)] + 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))]); + regs = [ + Reg (1, 2); + Reg (2, 3)]} + and expected_output = [ + Reg (0, 5); + Reg (1, 2); + Reg (2, 3); + Reg (3, 3)] + in let output_prgm = urm_mk input_prgm input_regs + in let output_regs = urm_run output_prgm + in + Assert.is_true (output_prgm = expected_urm); + Assert.is_true ((regs_sort output_regs) = expected_output)) + +let () = + Test.add_simple_test + ~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)] + 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))]); + regs = [ + Reg (1, 5)]} + and expected_output = [ + Reg (1, 120); + Reg (2, 5); + Reg (3, 5); + Reg (4, 0); + Reg (5, 24); + Reg (6, 5); + Reg (7, 24); + Reg (8, 0); + Reg (10, 0); + Reg (11, 0); + Reg (12, 0); + Reg (13, 0)] + in let output_prgm = urm_mk input_prgm input_regs + in let output_regs = urm_run output_prgm + in + Assert.is_true (output_prgm = expected_urm); + Assert.is_true ((regs_sort output_regs) = expected_output)) + +let () = if Array.mem "run-tests" Sys.argv then Test.launch_tests () + diff --git a/urm.ml b/urm.ml deleted file mode 100644 index 3b7068b..0000000 --- a/urm.ml +++ /dev/null @@ -1,41 +0,0 @@ -(* - * UPEM / L3 / Functional programming / Project: URM - * Pacien TRAN-GIRARD, Adam NAILI - *) - -open Common -open Instptr -open Reg - -(* 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 *) - -(* 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) - -let rec urm_run_pre pre = function - | { instptr = InstPtr(_, []) ; regs = reg_list } -> reg_list - | urm -> pre urm; urm_apply urm |> urm_run_pre pre - -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) - -(* 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/urm.mli b/urm.mli deleted file mode 100644 index 1949d28..0000000 --- a/urm.mli +++ /dev/null @@ -1,17 +0,0 @@ -(* - * UPEM / L3 / Functional programming / Project: URM - * Pacien TRAN-GIRARD, Adam NAILI - *) - -open Common - -(* Runs an URM. - * Returns all registers when the program halts. *) -val urm_run : urm -> reg list - -(* Runs an URM in trace mode. - * Returns all registers when the program halts. *) -val urm_run_trace : urm -> reg list - -(* Makes an URM. *) -val urm_mk : urmcmd list -> reg list -> urm diff --git a/urm_test.ml b/urm_test.ml deleted file mode 100644 index f223bf6..0000000 --- a/urm_test.ml +++ /dev/null @@ -1,151 +0,0 @@ -(* - * UPEM / L3 / Functional programming / Project: URM - * Pacien TRAN-GIRARD, Adam NAILI - *) - -open Common -open Instptr -open Urm -open Reg -open Kaputt.Abbreviations - -let () = - Test.add_simple_test - ~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)] - 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))]); - regs = [ - Reg (1, 2); - Reg (2, 3)]} - and expected_output = [ - Reg (0, 5); - Reg (1, 2); - Reg (2, 3); - Reg (3, 3)] - in let output_prgm = urm_mk input_prgm input_regs - in let output_regs = urm_run output_prgm - in - Assert.is_true (output_prgm = expected_urm); - Assert.is_true ((regs_sort output_regs) = expected_output)) - -let () = - Test.add_simple_test - ~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)] - 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))]); - regs = [ - Reg (1, 5)]} - and expected_output = [ - Reg (1, 120); - Reg (2, 5); - Reg (3, 5); - Reg (4, 0); - Reg (5, 24); - Reg (6, 5); - Reg (7, 24); - Reg (8, 0); - Reg (10, 0); - Reg (11, 0); - Reg (12, 0); - Reg (13, 0)] - in let output_prgm = urm_mk input_prgm input_regs - in let output_regs = urm_run output_prgm - in - Assert.is_true (output_prgm = expected_urm); - Assert.is_true ((regs_sort output_regs) = expected_output)) - -let () = if Array.mem "run-tests" Sys.argv then Test.launch_tests () - -- cgit v1.2.3