From 3f25710a891dfcd17f597c16dfedf5499bc1bbd6 Mon Sep 17 00:00:00 2001 From: pacien Date: Fri, 20 Apr 2018 23:32:38 +0200 Subject: Modularize everything --- README.md | 21 ++++++++++- common.ml | 1 + common.mli | 24 ++++++++++++ instptr.ml | 51 +++++++++++++++++++++++++ instptr.mli | 29 +++++++++++++++ main.ml | 10 +++++ makefile | 11 ++++++ parser.ml | 24 ++++++++++++ parser.mli | 15 ++++++++ projet.ml | 122 ------------------------------------------------------------ reg.ml | 16 ++++++++ reg.mli | 23 ++++++++++++ urm.ml | 34 +++++++++++++++++ urm.mli | 17 +++++++++ 14 files changed, 275 insertions(+), 123 deletions(-) create mode 120000 common.ml create mode 100644 common.mli create mode 100644 instptr.ml create mode 100644 instptr.mli create mode 100644 main.ml create mode 100644 makefile create mode 100644 parser.ml create mode 100644 parser.mli delete mode 100644 projet.ml create mode 100644 reg.ml create mode 100644 reg.mli create mode 100644 urm.ml create mode 100644 urm.mli diff --git a/README.md b/README.md index 59fe3e5..79d65fa 100644 --- a/README.md +++ b/README.md @@ -1 +1,20 @@ -# upem-progfunc-projet \ No newline at end of file +# UPEM / L3 Info / Functional programming / Project: URM + +Unlimited Register Machine in OCaml. + +## Usage + +* Requirements: ocaml, GNU Make, OCaml Makefile +* Build: `make nc` produces a binary named `urm` +* Clean: `make clean` + + +## Authors + +* Pacien TRAN-GIRARD +* Adam NAILI + + +## License + +Project distributed under the terms of the Creative Commons BY-NC-SA 3.0 license. diff --git a/common.ml b/common.ml new file mode 120000 index 0000000..ed50e6f --- /dev/null +++ b/common.ml @@ -0,0 +1 @@ +common.mli \ No newline at end of file diff --git a/common.mli b/common.mli new file mode 100644 index 0000000..a62b083 --- /dev/null +++ b/common.mli @@ -0,0 +1,24 @@ +(* + * UPEM / L3 / Functional programming / Project: URM + * Pacien TRAN-GIRARD, Adam NAILI + *) + +type line = int +type regidx = int +type regval = int +type reg = Reg of regidx * regval + +type urmcmd = + | 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 + +type urm = { + instptr : instptr; + regs : reg list +} + +exception Syntax_error diff --git a/instptr.ml b/instptr.ml new file mode 100644 index 0000000..9e472c4 --- /dev/null +++ b/instptr.ml @@ -0,0 +1,51 @@ +(* + * UPEM / L3 / Functional programming / Project: URM + * Pacien TRAN-GIRARD, Adam NAILI + *) + +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 + | [] -> 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) + +(* Moves the pointer to the next instruction *) +let instptr_move_down = function + | 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 *) +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" + +(* 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 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 new file mode 100644 index 0000000..f1252b5 --- /dev/null +++ b/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/main.ml b/main.ml new file mode 100644 index 0000000..e85aeb2 --- /dev/null +++ b/main.ml @@ -0,0 +1,10 @@ +(* + * UPEM / L3 / Functional programming / Project: URM + * Pacien TRAN-GIRARD, Adam NAILI + *) + +open Common +open Parser +open Instptr +open Reg +open Urm diff --git a/makefile b/makefile new file mode 100644 index 0000000..f027be5 --- /dev/null +++ b/makefile @@ -0,0 +1,11 @@ +RESULT = urm +LIBS = str +SOURCES = \ + common.ml \ + parser.mli parser.ml \ + instptr.mli instptr.ml \ + reg.mli reg.ml \ + urm.mli urm.ml + +OCAMLMAKEFILE = /usr/share/ocamlmakefile/OCamlMakefile +include $(OCAMLMAKEFILE) diff --git a/parser.ml b/parser.ml new file mode 100644 index 0000000..e01208f --- /dev/null +++ b/parser.ml @@ -0,0 +1,24 @@ +(* + * 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 + | [] -> [] + | "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 diff --git a/parser.mli b/parser.mli new file mode 100644 index 0000000..d210396 --- /dev/null +++ b/parser.mli @@ -0,0 +1,15 @@ +(* + * 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 + +(* Parses the string representation of a program. *) +val program_of_string : string -> urmcmd list diff --git a/projet.ml b/projet.ml deleted file mode 100644 index 67e6221..0000000 --- a/projet.ml +++ /dev/null @@ -1,122 +0,0 @@ -#load "str.cma" - -type line = int -type regidx = int -type regval = int -type reg = Reg of regidx * regval - -type urmcmd = - | 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 - -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 = 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 - -(* 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 - | 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) - -(* Moves the pointer to the next instruction *) -let instptr_move_down = function - | 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 *) -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" - -(* 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 instptr_end = function - | 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. *) -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 - -(* 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 } - -(* 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) - -(* Launches the URM *) -let rec urm_run = function - | { 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 } - diff --git a/reg.ml b/reg.ml new file mode 100644 index 0000000..b27a868 --- /dev/null +++ b/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 reg1 reg2 = (reg_val reg1) - (reg_val reg2) + +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 diff --git a/reg.mli b/reg.mli new file mode 100644 index 0000000..15d53de --- /dev/null +++ b/reg.mli @@ -0,0 +1,23 @@ +(* + * 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 diff --git a/urm.ml b/urm.ml new file mode 100644 index 0000000..49e970b --- /dev/null +++ b/urm.ml @@ -0,0 +1,34 @@ +(* + * 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) + +(* Launches the URM *) +let rec urm_run = function + | { instptr = InstPtr(_, []) ; regs = reg_list } -> reg_list + | urm -> urm_apply urm |> urm_run + +let urm_run_trace = urm_run (* TODO *) + +(* 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 new file mode 100644 index 0000000..1949d28 --- /dev/null +++ b/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 -- cgit v1.2.3