diff options
Diffstat (limited to 'projet.ml')
-rw-r--r-- | projet.ml | 122 |
1 files changed, 0 insertions, 122 deletions
diff --git a/projet.ml b/projet.ml deleted file mode 100644 index 67e6221..0000000 --- a/projet.ml +++ /dev/null | |||
@@ -1,122 +0,0 @@ | |||
1 | #load "str.cma" | ||
2 | |||
3 | type line = int | ||
4 | type regidx = int | ||
5 | type regval = int | ||
6 | type reg = Reg of regidx * regval | ||
7 | |||
8 | type urmcmd = | ||
9 | | Copy of regidx * regidx | ||
10 | | Jump of regidx * regidx * line | ||
11 | | Succ of regidx | ||
12 | | Zero of regidx | ||
13 | |||
14 | type instptr = InstPtr of (line * urmcmd) list * (line * urmcmd) list | ||
15 | |||
16 | type urm = { | ||
17 | instptr : instptr; | ||
18 | regs : reg list | ||
19 | } | ||
20 | |||
21 | exception Syntax_error | ||
22 | |||
23 | let rec string_of_file f = | ||
24 | try | ||
25 | let str = input_line f | ||
26 | in str ^ " " ^ (string_of_file f) | ||
27 | with End_of_file -> "" | ||
28 | |||
29 | let rec program_of_lex = function | ||
30 | | [] -> [] | ||
31 | | "zero" :: arg_1 :: tail -> (Zero (int_of_string arg_1)) :: (program_of_lex tail) | ||
32 | | "succ" :: arg_1 :: tail -> (Succ (int_of_string arg_1)) :: (program_of_lex tail) | ||
33 | | "copy" :: arg_1 :: arg_2 :: tail -> (Copy ((int_of_string arg_1), (int_of_string arg_2))) :: (program_of_lex tail) | ||
34 | | "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) | ||
35 | | _ -> raise Syntax_error | ||
36 | |||
37 | let program_of_string str = | ||
38 | let lex = Str.split (Str.regexp "[\t\n(),]+") str | ||
39 | in List.iter (fun s -> print_string s; print_newline ()) lex; program_of_lex lex | ||
40 | |||
41 | (* Creates a pointer of instruction from an urm command list *) | ||
42 | let instptr_mk urmcmd_list = | ||
43 | let rec aux urmcmd_list count acc = | ||
44 | match urmcmd_list with | ||
45 | | [] -> acc | ||
46 | | instr :: tail -> aux tail (count + 1) ((count, instr) :: acc) | ||
47 | in InstPtr([], List.rev (aux urmcmd_list 0 [])) | ||
48 | |||
49 | (* Moves the pointer to the previous instruction *) | ||
50 | let instptr_move_up = function | ||
51 | | InstPtr([], list2) -> InstPtr([], list2) | ||
52 | | InstPtr(instr :: list1, list2) -> InstPtr(list1, instr :: list2) | ||
53 | |||
54 | (* Moves the pointer to the next instruction *) | ||
55 | let instptr_move_down = function | ||
56 | | InstPtr(list1, []) -> InstPtr(list1, []) | ||
57 | | InstPtr(list1, instr :: list2) -> InstPtr(instr :: list1, list2) | ||
58 | |||
59 | (* Returns the couple from the current pointer position : (line, instruction) where instruction is an urm command or fails if there is no instruction pointed *) | ||
60 | let instptr_get = function | ||
61 | | InstPtr(list1, (l, Zero(a)) :: tail)-> (l, Zero(a)) | ||
62 | | InstPtr(list1, (l, Succ(a)) :: tail) -> (l, Succ(a)) | ||
63 | | InstPtr(list1, (l, Copy(a, b)) :: tail) -> (l, Copy(a, b)) | ||
64 | | InstPtr(list1, (l, Jump(a, b, c)) :: tail) -> (l, Jump(a, b, c)) | ||
65 | | InstPtr(_, [])-> failwith "No instruction left" | ||
66 | |||
67 | (* Converts the current instruction pointed into a string (line and instruction formatted). If there is no instruction, returns "null" *) | ||
68 | let instptr_string instptr = | ||
69 | let aux = function | ||
70 | | l, Zero(a) -> (string_of_int l) ^ ": Zero " ^ (string_of_int a) | ||
71 | | l, Succ(a) -> (string_of_int l) ^ ": Succ " ^ (string_of_int a) | ||
72 | | l, Copy(a, b) -> (string_of_int l) ^ ": Copy " ^ (string_of_int a) ^ " " ^ (string_of_int b) | ||
73 | | l, Jump(a, b, c) -> (string_of_int l) ^ ": Jump " ^ (string_of_int a) ^ " " ^ (string_of_int b) ^ " " ^ (string_of_int c) | ||
74 | in try aux (instptr_get instptr) with _ -> "null" | ||
75 | |||
76 | (* Returns true if the instruction pointer is not pointing on any instruction (end of the instruction list) *) | ||
77 | let instptr_end = function | ||
78 | | InstPtr(_, []) -> true | ||
79 | | _ -> false | ||
80 | |||
81 | (* Returns the pointer of instruction after a jump decided by the given offse t*) | ||
82 | let rec instptr_jump ptr offset = match offset with | ||
83 | | 0 -> ptr | ||
84 | | _ when offset > 0 -> instptr_jump (instptr_move_up ptr) (offset - 1) | ||
85 | | _ -> instptr_jump (instptr_move_down ptr) (offset + 1) | ||
86 | |||
87 | let reg_idx (Reg(idx, _)) = idx | ||
88 | let reg_val (Reg(_, value)) = value | ||
89 | |||
90 | (* Compares two registers. Returns -1 if reg1 is lower than reg2, 1 if it is greater than reg2 or 0 if both are equals. *) | ||
91 | let reg_compar reg1 reg2 = (reg_val reg1) - (reg_val reg2) | ||
92 | |||
93 | (* Returns the value contained in the specified register in a register list *) | ||
94 | let regs_get reglist idx = List.find (fun (Reg(x,v)) -> x = idx) reglist |> reg_val | ||
95 | |||
96 | (* Set the value of the register to value, or creates it to the value specified if it does not exist *) | ||
97 | let regs_set reglist index value = Reg(index, value) :: List.filter (fun (Reg(x, v)) -> x != index) reglist | ||
98 | |||
99 | (* Gives a new urm by moving down its instruction pointer *) | ||
100 | let urm_move_down urm = { instptr = instptr_move_down urm.instptr ; regs = urm.regs } | ||
101 | |||
102 | (* TODO: Verifier pour JUMP que a et b sont deux registres initialisés *) | ||
103 | |||
104 | (* Applies the current instruction pointed by the pointer of instruction. Modifies the pointer of instruction for every instruction *) | ||
105 | let urm_apply urm = | ||
106 | let aux = function | ||
107 | | _, Zero(a) -> { instptr = urm.instptr ; regs = regs_set (urm.regs) a 0 } |> urm_move_down | ||
108 | | _, Copy(a, b) when a != b -> { instptr = urm.instptr ; regs = regs_set urm.regs a (regs_get urm.regs b) } |> urm_move_down | ||
109 | | _, Copy(a, b) -> failwith "Copy from one register to itself" | ||
110 | | _, Succ(a) -> { instptr = urm.instptr ; regs = regs_set urm.regs a ((regs_get urm.regs a) + 1) } |> urm_move_down | ||
111 | | _, 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 } | ||
112 | | _, _ -> { instptr = urm.instptr ; regs = urm.regs } |> urm_move_down | ||
113 | in if instptr_end urm.instptr then urm else aux (instptr_get urm.instptr) | ||
114 | |||
115 | (* Launches the URM *) | ||
116 | let rec urm_run = function | ||
117 | | { instptr = InstPtr(_, []) ; regs = reg_list } -> reg_list | ||
118 | | urm -> urm_apply urm |> urm_run | ||
119 | |||
120 | (* Creates an URM from a command list and a register list *) | ||
121 | let urm_mk cmd_list reg_list = { instptr = (instptr_mk cmd_list) ; regs = reg_list } | ||
122 | |||